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Abstract 

This  report  describes  a  suite  of  benchmarks  for  Prolog  implementation  research.  It  includes 
an  explanation  of  the  format  of  the  suite,  which  is  meant  to  facilitate  use  of  the  benchmarks. 
The  principal  idea  of  this  format  is  to  maintain  for  each  benchmark  a  master  file  from  which 
particular  instances  -  for  particular  Prolog  execution  systems,  for  particular  statistics  to  cap¬ 
ture,  etc.  -  are  generated  automatically  using  a  preprocessor.  A  preprocessor  provided  with 
the  suite  for  this  purpose  is  described,  along  with  a  related  utility  and  a  simple  framework  for 
execution  time  measurement.  Source  code  for  these  is  appended.  Possibilities  for  future 
work  with  respect  both  to  this  suite  and  to  Prolog  benchmarking  more  generally  are  dis¬ 
cussed  briefly.  For  each  benchmark  in  the  suite,  source  code  and  execution  times  under  C 
Prolog  and  Quintus  Prolog  (compiled)  on  a  Sun  3/60  are  appended. 


1  Introduction 

This  report  describes  a  suite  of  Prolog  benchmarks  compiled  for  the  Aquarius  project  at  Berkeley. 
This  suite  is  primarily  intended  as  a  tool  for  researchers  trying  to  understand  and  improve  Prolog 
implementations.  It  is  not  specialized  to  any  single  Prolog  implementation  (hardware  or 
software)  or  application  area.  It  includes  benchmarks  which  have  been  collected  by  Aquarius 
over  a  period  of  several  years  during  which  the  project  has  undertaken  work  on  many  aspects  of 
Prolog  implementation  and  application.  [Des87]  Though  some  of  the  benchmarks  originated  with 
members  of  Aquarius,  most  came  from  elsewhere.  Many  are  well-known  and  have  been  widely- 
used  to  characterize  Prolog  implementations  (see,  for  example,  [Bur87],  [DDP85],  [Dob87], 
[DSP85],  [NSD88],  [Pon89],  [Qui88],  [Tic86],  [Tic87],  [War83]);  a  few,  such  as  the  set  by  David 
H.  D.  Warren,  can  fairly  be  called  classics.  Thus,  besides  the  particular  history  of  Aquarius,  these 
benchmarks  embody  an  important  share  of  the  experience  and  wisdom  of  the  logic  programming 
community.  It  is  thus  reasonable  to  hope  this  suite  may  be  useful  not  only  within  Aquarius  but 
beyond  it  as  well. 

This  is  not  “the  ultimate  Prolog  benchmark  suite.”  An  “ultimate”  benchmark  suite,  that  is,  one 
including  an  ideal  set  of  benchmarks  for  every  circumstance,  is  surely  impossible.  Indeed,  no 
general  suite  such  as  this  can  include  a  “complete”  set  of  benchmarks  for  nearly  any  cir¬ 
cumstance.  Characterizing  an  implementation  of  Prolog  (or  any  other  non-trivial  programming 
system)  is  a  complex  project  which  requires  more  than  results  from  a  few  standard  benchmarks. 
Standard  benchmarks  well-analyzed  can  contribute  a  useful  sketch  of  an  implementation.  They 
can  provide  approximate  comparisons  of  alternative  features  and  can  suggest  useful  possibilities 
for  more  implementation-specific  benchmarks  to  probe  behavior  more  closely. 
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2  The  Benchmarks 

Appendix  A  is  a  catalog  of  the  suite.  It  gives  the  name  of  each  benchmark  and  a  brief  description 
of  what  the  benchmark  does.  This  information  is  also  present  in  the  files  containing  the  bench¬ 
mark  code.  Appendix  G  includes  a  listing  of  each  of  these  files.  Appendix  A  also  notes  refer¬ 
ences  which  further  describe  each  benchmark  and  how  it  has  been  used. 

As  Appendix  A  indicates,  the  benchmarks  are  grouped  into  families,  including  the  warren 
family  from  David  H.  D.  Warren;  the  berkeley  family  from  the  Aquarius  project  at  Berkeley, 
which  has  been  used  extensively  to  characterize  the  PLM  and  its 
successors  [DSP85]  [Dob87]  [DDP85]  [NSD88];  the  gabriel  family,  which  derives  from  a 
suite  of  Lisp  benchmarks  compiled  by  R.  P.  Gabriel  [Gab85];  the  pereira  family  from  Fer¬ 
nando  C.  N.  Pereira  (courtesy  of  Quintus  Computer  Systems,  Inc.),  an  outstanding  contribution  of 
twenty-six  “microscopic”  benchmarks  which  explore  a  multitude  of  Prolog  implementat.on 
issues  from  structure  unification  to  argument  indexing  [Bur87]  [Qui88];  the  fft  family  from 
Richard  A.  O’Keefe,  which  exercises  Prolog  floating  point  facilities  with  the  fast  fourier 
transform;  the  tp  family  from  Ross  Overbeek,  which  is  a  set  of  propositional  theorem  proving 
exercises;  and  the  asp  family  from  the  ASP  (Advanced  Silicon  compiler  in  Prolog)  group  of  the 
Aquarius  project,  which  executes  stages  in  the  silicon-compilation  of  several  devices.  [Bus88] 
Other  benchmarks  include  the  natural  language  system  front-end  chat_parser  from  David 
H.  D.  Warren  and  Fernando  C.  N.  Pereira [WP82];  the  intuitionistic  logic  interpreter  ili  from 
Seif  Haridi  [Tic87];  and  the  plm_compiler  from  Peter  Van  Roy.  [Van84] 

These  benchmarks  share  the  following  characteristics: 

•  They  are,  on  the  whole,  well-written,  in  a  variety  of  accepted  programming 
styles. 

•  They  are  nearly  all  well-known  and  have  been  used  at  Berkeley  and  elsewhere. 

•  They  use  sufficiently  “vanilla”  Prolog  that  they  will  run  with  little  or  no 
modification  under  most  Prolog  implementations.  In  particular,  all  of  them 
will  run  under  C  Prolog  (version  1.5)  and  under  Quintus  Prolog  (version  2.0).* 

Several  of  the  benchmarks  include  code  in  another  language  (gabriel/lisp  [Gab85]  and 
tp/c)  whose  performance  can  be  compared  with  that  of  the  Prolog  code. 

C  Prolog  and  Quintus  Prolog  have  been  chosen  as  reference  implementations  not  only  because 
they  are  well-known  and  widely-used  but  because  they  typify  alternatives  among  such  implemen¬ 
tations.  C  Prolog  is  a  well-constructed  but  plain,  non-commercial  implementation  with  few 
“frills.”  By  contrast,  Quintus  Prolog  is  a  sophisticated,  commercial  implementation  with 
features  such  as  compilation,  free  mixing  of  compiled  and  interpreted  code,  first  argument  index¬ 
ing,  etc. 

Appendix  B  tabulates  execution  times  for  the  benchmarks  under  C  Prolog  and  Quintus  Prolog 
(compiled)  on  a  Sun  3/60.  Execution  time  is  certainly  not  the  only  statistic  relevant  to  character¬ 
izing  an  implementation,  but  it  is  significant,  and  relative  execution  times  convey  some  sense  of 
the  relative  amounts  of  “work”  done  by  the  benchmarks.  This  is  useful  for  becoming  acquainted 
with  the  suite. 


"  Several  in  the  tp  family  fail  to  run  to  completion  because  they  use  too  much  memory. 
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Appendix  C  tabulates  Prolog  features  used  by  the  benchmarks.  It  is  meant  mainly  to  show  what 
features  an  implementation  must  support  to  run  a  given  benchmark,  with  emphasis  on  features 
which  group  into  “functional  sub-domains’’  of  Prolog  and  which  may  not  be  realized  in  the  early 
stages  of  a  research  implementation.  Such  features  include  integer  or  floating-point  arithmetic 
(is/2,  etc.),  structure  manipulation  (functor/3,  arg/3,  =.  .  / 2),  and  database  editing 
(assert/1,  retract/1,  abolish/2).  For  full  details  about  a  particular  benchmark,  of 
course,  it  is  necessary  to  examine  the  benchmark  code  directly,  but  Appendix  C  may  provide  a 
useful  starting  point. 

It  should  be  clear  that  the  benchmarks  chosen  for  this  suite  are  by  no  means  the  only  ones  which 
might  have  been  chosen.  Many  other  possibilities  exist.  It  is  expected  that  this  suite  will  be 
revised  over  time. 


3  The  Format 

Benchmarks  for  implementors  must  run  not  only  in  complete,  “production”  systems  (like  C  Pro¬ 
log  and  Quintus  Prolog)  but  in  incomplete,  experimental  systems  used  for  implementation 
research.  For  example,  at  Berkeley  we  have  instruction-level  and  functional-unit-level  simulator 
programs  for  various  pieces  of  hardware  intended  to  support  high-performance  Prolog  execution. 
Such  systems  typically  do  not  offer  users  the  sort  of  interaction  that  conventional  Prolog  systems 
offer.  In  a  conventional  Prolog  system,  a  benchmark  might  be  invoked  with  a  query  to  the  inter¬ 
preter  like 

?-  run  (a,  10,  [cputime]). 

where  the  form  of  run/  3  is 

run (  +Name,  +Datar  +Statistics  )* 

In  systems  devised  for  implementation  research,  however,  there  may  well  be  no  analogous  way  to 
specify  at  run-time  what  code  to  run,  what  data  to  use,  or  what  statistics  to  capture.  (This  is  true 
to  various  degrees  of  our  simulator  programs  at  Berkeley.)  Instead,  this  information  must  be 
“hard-wired”  into  the  code  these  systems  are  given  to  run.  Of  course,  implementors  could 
extend  their  systems  to  eliminate  such  restrictions,  but  they  are  likely  to  consider  this  a  nuisance 
orthogonal  to  the  thrust  of  their  research. 

The  loss  of  flexibility  is  itself  a  significant  nuisance,  however.  It  is  a  burden  to  maintain  a 
separate  version  of  every  benchmark  for  every  system,  for  every  statistic  to  capture,  etc.  Con¬ 
sistency  and  documentation  are  likely  to  deterior .  ..  Fhis  is  especially  so  when  a  group  of  people 
work  together  to  develop  and  characterize  an  impl.'  e  itation,  as  is  commonly  the  case. 

The  benchmarks  in  this  suite  are  set  in  a  format  which  addresses  these  issues.  The  philosophy  is 
to  provide  for  each  benchmark  a  master  file  from  which  files  for  particular  cases  are  generated 
automatically  by  a  preprocessor.  A  preprocessor  called  pre  is  provided  with  the  suite  for  this  pur¬ 
pose.  It  is  designed  to  support  easy  and  fast  specification  and  documentation  of  particular  cases 
and  to  be  easy  and  fast  to  run.  Also,  a  utility  called  MAKE  is  provided  to  expedite  invocation  of 
pre ,  and  a  simple  framework,  or  “bench,”  for  execution  time  measurement  is  provided,  ready- 
to-run  under  systems  such  as  C  Prolog  and  Quintus  Prolog.  An  interface  to  the  bench  is  provided 
for  each  benchmark  in  the  suite.  The  following  sub-sections  describe  pre,  MAKE,  and  the  bench 
in  more  detail  and  then  work  through  an  example  of  their  use  with  a  benchmark  from  the  suite. 


+  before  an  argument  indicates  the  argument  is  an  input  to  the  predicate. 


3.1  pre 


pre  is  a  preprocessor  offering,  among  other  things,  simple  macro  assignment  and  expansion,  con¬ 
ditional  processing,  and  file  inclusion.  Both  syntactically  and  semantically,  it  is  similar  to  ANSI 
standard  C  preprocessors,  with  omissions  and  extensions.*  pre  itself  is  implemented  in  ANSI 
standard  C  with  assistance  from  the  lexical  analyzer  generator  LEX  and  the  parser  generator 
YACC.  The  source  code  is  furnished  with  the  suite  and  listed  in  Appendix  D.  3.4  below  intro¬ 
duces  the  major  features  of  pre,  and  a  manual  for  pre  is  in  preparation.  To  get  some  flavor  of 
what  files  for  processing  by  pre  look  like,  the  reader  may  wish  to  inspect  Figure  1  (p.  7)  before 
reading  further. 

Many  existing  preprocessors  do  most  of  what  pre  does.  The  specialized  features  which  motivated 
making  pre  center  on  facilitating  the  specification  and  documentation  of  “particular  cases”  of  a 
“general  scheme.”  Here  we  consider  one  example,  the  option  directive.  The  option 
directive  specifies  a  list  of  identifiers  and  a  text  string.  Each  identifier  is  presumably  an  “option” 
for  pre  processing,  that  is,  a  macro  which,  when  assigned  at  pre  invocation,  contributes  to  decid¬ 
ing  which  “particular  case”  pre  generates.  The  text  string  is  presumably  documentation  of  the 
roles  and  relationships  of  the  specified  option  identifiers.  The  significance  of  this  directive  is  that 
pre  has  a  mode  in  which  it  searches  its  input  for  option  directives.  When  it  finds  one,  it  can 
display  the  documentation  text  to  the  terminal,  and/or  it  can  list  the  specified  options,  one  per 
line,  to  the  terminal  or  to  a  file.  The  precise  action  pre  takes  is  set  by  arguments  given  at  invoca¬ 
tion.  In  the  first  case  (invoked  by  the  -D  (for  Document)  command  line  argument),  the  result  is  a 
list  of  what  a  user  must  know  about  how  to  process  the  file  with  pre:  what  options  there  are,  and 
what  they  mean.  This  information  is  thus  conveniently  available  both  within  the  file  and  on-line 
upon  demand.  In  the  second  case  (invoked  by  the  -L  (for  List)  command  line  argument),  the  list, 
if  directed  to  the  terminal,  may  serve  as  abbreviated  documentation,  or,  if  directed  to  a  file,  may 
serve  for  subsequent  use  by  MAKE,  as  described  in  32  below. 

A  C  preprocessor-like  syntax  was  chosen  for  pre  for  two  main  reasons.  First,  for  purposes  of  a 
Prolog  benchmark  suite,  it  seems  desirable  that  pre  syntax  be  easily  distinguishable  from  that  of 
Prolog  so  that  pre  directives  in  a  benchmark  master  file  stand  out  clearly  from  the  benchmark 
code  itself.  Second,  since  most  prospective  users  are  likely  to  be  familiar  with  C  and  hence  with 
C  preprocessors,  a  C  preprocessor-like  syntax  is  likely  to  be  easy  for  them  to  learn. 

It  may  be  wondered  why  pre  is  implemented  in  C  rather  than  in  Prolog,  since  it  is  meant  for  use 
with  a  Prolog  benchmark  suite  and  since  Prolog  is  in  some  obvious  ways  superior  for  processing 
language.  The  answer  has  to  do  primarily  with  portability.  To  support  some  of  the  features 
which  are  desirable  for  pre  to  offer,  a  Prolog  implementation  of  pre  would  need  to  use  some 
non-standard  Prolog  features.  For  example,  to  support  a  preassigned  macro  for  the  date,  it  would 
be  necessary  in  most  Prolog  systems  to  make  a  foreign  function  call  to  an  operating  system  util¬ 
ity.  This  sort  of  thing  is  done  in  quite  different  ways  by  different  Prolog  systems.  Because  there 
is  not  any  one  Prolog  system  which  every  potential  user  of  the  benchmark  suite  is  likely  to  have, 
this  is  a  problem.  C,  by  contrast,  is  fairly  standardized  and  widely  available.* 


*  The  major  omissions  are:  macros  with  arguments;  arithmetic  in  conditional  expressions;  the  include  <...>  directive; 
the  1  ine  directive.  The  first  two  may  be  supported  in  future  revisions.  Other  ANSI  standard  C  preprocessor  directives  - 
define,  include  error,  if,  ifdef,  ifndef,  elif,  else,  endif  -  are  supported  (define  as  a 

synonym  for  assign  and  elif  as  a  synonym  for  elseif).  Error  handling  may  also  be  improved  in  future  revisions. 

f  pre  is  made  with  help  from  LEX  and  YACC,  but  since  these  generate  C  code,  not  every  potential  user  must  have  them. 
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3.2  MAKE 


MAKE  is  a  utility  which  meshes  with  pre  to  expedite  processing  files  with  pre.  It  allows  the  user 
to  specify  concisely  what  file  to  process,  what  options  to  assign,  and  where  to  write  the  output. 
3.4  below  demonstrates  the  use  of  MAKE.  The  source  code  is  included  with  the  suite  and  listed 
in  Appendix  E.  MAKE  began  as  a  C-shell  (esh)  script;  primarily  for  the  sake  of  speed,  it  is  now 
implemented  in  C. 

The  main  convenience  MAKE  provides  is  prefix  expansion  for  pre  processing  options.  If  MAKE 
is  invoked  with  the  -L  (for  List)  argument,  it  invokes  pre  with  this  same  argument  and  writes  out¬ 
put  from  pre,  a  sequence  of  option  identifiers  specified  by  option  directives,  to  a  file.  It  can 
subsequently  use  this  file  to  expand  prefixes  of  these  option  identifiers.  For  example,  if 
QUINTUS_PL  is  an  option  that  determines  whether  the  output  from  pre  is  specialized  for 
Quintus  Prolog,  rather  than 

pre  -sQUINTUS_PL 

to  produce  output  thus  specialized,  it  suffices  to  enter 

MAKE  Q  . . . 

if  no  other  option  has  first  letter  Q.  Or,  if  STRATEGY  is  an  option  that  determines  which  stra¬ 
tegy  the  output  for  a  state-space  search  program  realizes,  rather  than 

pre  -aSTRATEGY=depth_f irst  ...+ 

to  produce  output  which  realizes  depth- first  search,  it  suffices  to  enter 

MAKE  S=depth_f irst  . . . 

if  no  other  option  has  first  letter  S.  If  a  given  prefix  is  ambiguous,  MAKE  resolves  it  to  the  first 
identifier  in  the  option  list  file  of  which  it  is  a  prefix.  If  a  given  string  is  not  a  prefix  of  any 
identifier  in  the  option  list  file,  MAKE  writes  an  error  message  and  terminates.  (This  is  meant  to 
discourage  the  use  of  “undeclared”  options.  If  users  find  this  disagreeable,  they  can  easily 
change  MAKE  to  do  something  else,  e.g.,  to  pass  such  strings  on  to  pre  without  modification.) 
This  facility  has  proven  most  convenient  in  practice. 

3.3  The  Bench 

The  bench  is  a  framework  for  measuring  Prolog  benchmark  execution  times.  It  is  ready-to-run 
under  C,  BIM,  Quintus,  SB,  and  SICStus  Prolog,  and  it  can  easily  be  extended  to  other  imple¬ 
mentations.  It  is  provided  primarily  as  a  convenience  for  becoming  acquainted  with  the  bench¬ 
mark  suite  or  for  comparing  performance,  to  the  extent  of  execution  time,  of  experimental  sys¬ 
tems  with  well-known  standard  Prolog  systems. 

An  interface  to  the  bench  is  provided  for  each  benchmark  in  the  suite.  These  interfaces  are  in 
files  separate  from  the  benchmark  master  files.  (They  are  thus  out  of  the  way  when  the  bench  is 
not  in  use.)  The  core  of  each  interface  is  a  clause  of  benchmark/ 4  - 

benchmark (  +Name,  - Action ,  -Control,  -Iterations  )* 

-sQUINTUS_PL  means  set  macro  QUINTUS_PL,  that  is,  assign  il  value  1. 

*  -aSTRATEGY«depth_f irst  means  assign  macro  STRATEGY  value  depth  first. 

1  -  before  an  argument  indicates  the  argument  is  an  output  from  the  predicate. 
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where 


Name  is  the  name  of  the  benchmark; 

Action  is  a  term  such  that  call  (Action)  executes  the  benchmark; 

Control  is  a  “dummy”  term  whose  structure  and  instantiation  are  identical  to 
those  of  Action ; 

Iterations  is  the  default  number  of  iterations  of  Action  and  Control  to 
execute  in  a  run.* 

For  example,  the  clause  for  the  benchmark  nreverseis 

benchmark (nreverse, 

nr  e  verse  ([1,2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 

13, 14, 15, 16, 17, 18, 19, 20, 21, 

22,  23,  24,25,26,  27,28, 29,  30] ,_) , 
dummy ([1,2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 

13, 14, 15, 16, 17, 18, 19,20, 21, 
22,23,24,25,26,27,28,29,30] ,_) , 

..  000). 

The  “active”  component  of  the  bench  is  the  “driver”  listed  in  Appendix  F.  The  top-level  predi¬ 
cate  is  driver/1  - 

driver (+Name) 

where 


Name  is  the  name  of  the  benchmark. 

This  predicate  operates  as  follows: 

(1)  It  calls  benchmark/ 4  (with  the  given  Name)  to  find  out  how  many 
Iterations  of  the  Action  and  its  Control  to  perform; 

(2)  It  calls  get_cpu_time/2; 

(3)  It  repeats  call  (Action)  the  specified  number  of  Iterations', 

(4)  It  again  calls  get_cpu_t  ime  /  2 ; 

(5)  It  repeats  call  (Control)  the  specified  number  of  Iterations', 

(6)  It  yet  again  calls  get__cpu_time/2; 

(7)  It  calls  report/ 6  to  which  it  passes  Name,  Iterations,  and  the  results 
of  the  three  calls  to  ge t_cpu_t  ime  /  2 . 

The  Control  calls  thus  compensate  for  the  overhead  associated  with  the  repetition  and  with 
the  statistical  predicate  get_cpu_time/2.  (If  this  rather  cumbersome  description  is  confus¬ 
ing,  look  at  Appendix  F  -  the  code  is  simple.) 

A  clause  of  the  form 

benchmark (  +Name  *  Alterations  ) 

is  also  defined  to  permit  the  user  to  vary  the  number  of  iterations  from  that  specified  in  the 
benchmark/ 4  clause. 


’  This  notion  of  benchmark/  4  was  invented  by  Fernando  C.  N.  Pereira. 
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♦  /* 

nreverse.m:  Warren  benchmark  nreverse  macter  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s>:  $ _ OPTIONS _ $ 

% 

%  nreverse 

% 

%  David  H.  D.  Warren 

% 

%  "naive"-reverse  a  list  of  30  integers 


#if  BENCH 
♦  include 
#else 

nreverse  :■ 


#endif 


" . nreverse . bench” 

nreverse  (  [1, 2, 3,  4, 5,  6, 7, 8, 9,  10,  11,  12, 

13, 14, 15, 16, 17, 18, 19, 20, 21, 

22, 23, 24, 25, 26, 27, 28, 29, 30] ,_) . 


♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 
statistics,  option  DUMMY  substitutes  a  'dummy'  for 
the  benchmark  execution  predicate  (nreverse/2) . 


#if 


> 

> 

> 

> 

> 

> 

> 

> 

> 

DUMMY 


To  use  this,  generate  code  without  DUMMY  and  run 
it,  generate  code  with  DUMMY  and  run  it,  and  take 
the  difference  of  the  performance  statistics. 

This  functionality  is  automatically  provided  with 
execution  time  measurement  when  BENCH  is  selected. 


nreverse (_,_) . 

♦else 

nreverse ( (X I L0 ], L)  nreverse (L0, LI] ,  concatenate (LI ,  [X] , L)  . 
nreverse ( [ ] , f ] ) . 


concatenate ( [X I  LI] , L2,  [X I L3] )  concatenate (LI, L2, L3)  . 
concatenate ( [ ] , L, L) . 

♦endif 


Figure  1 
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The  statistical  predicate  get_cpu_time/2  is  (like  most  statistical  predicates)  highly  system- 
dependent.  This  system-dependency  is  conveniently  taken  care  of  by  pre.  If  one  of  the  options 
BIM_PL,  C_PL,  QUINTUS_PL,  SB_PL,  or  SICSTUS_PL  is  assigned  at  pre  invocation, 
then  an  appropriate  definition  for  get_cpu_time/2  is  generated  automatically.  It  is  easy  to 
add  other  options  for  other  Prolog  systems  having  mechanisms  for  obtaining  execution  time. 


The  output  of  a  benchmark  (if  any)  is  generally  unimportant  in  the  context  of  execution  time 
measurement  -  thus  the  second  argument  of  nreverse/2  in  the  benchmark/4  clause  above 
is  anonymous.  But  output  is  sometimes  useful  for  verifying  that  a  given  benchmark  is  executing 
completely  and  correctly.  The  interface  to  the  bench  for  most  of  the  benchmarks  in  the  suite 
includes  a  clause  of  show/ 1  - 


where 


show ( +Name) 


Name  is  the  name  of  the  benchmark. 

This  predicate  is  designed  to  show  what  the  benchmark  does.  For  example,  the  clause  for 
nreverse  is 

show (nreverse)  nreverse ( [ 1, 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 , 11 , 12 , 

13,  14, 15, 16, 17, 18, 19, 20, 21, 
22,23,24,25,26,27,28,29,30] ,R) , 
write (' reverse  of'),  nl, 
write  ([1,2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 

13,  14,  15,  16, 17,  18, 19, 20,21, 
22,23,24,25,26,27,28,29,30]) ,  nl, 
write  (is) ,  nl, 
write (R) ,  nl . 


3.4  An  Example 

We  consider  the  classic  benchmark  nreverse  of  the  warren  family.  The  master  file  for  this 
benchmark  is  called  nreverse. m.  It  resides  in  a  directory  which  also  contains: 
.  nreverse  .bench,  a  symbolic  link  to  set-up .  nreverse,  which  contains  the  interface 
for  nreverse  to  the  bench;  MAKE,  a  symbolic  link  to  the  executable  MAKE ;  and  .pre,  a 
symbolic  link  to  the  executable  pre.  This  scheme  and  the  format  of  the  files  nreverse  .m  and 
set-up.  nreverse  are  typical  for  the  whole  suite. 

Figure  1  (p.  7)  is  a  listing  of  nreverse  .m.  Lines  beginning  with  #  are  pre  directive  lines. 
Ordinarily,  pre  directives  may  not  extend  over  more  than  one  line;  however,  newlines  are  permit¬ 
ted  within  comments,  delimited  by  /*  and  */,  and  within  text  strings,  delimited  by  "’s.‘  The 
first  three  lines  of  nreverse .  m  form  a  header  for  the  file  by  means  of  a  pre  comment.  This  is 
never  written  to  the  output;  a  header  for  the  output  is  formed  by  the  next  block  of  eight  lines. 
Two  features  of  these  lines  warrant  attention.  On  the  first  line,  the  preassigned  macros 

_ MDAY _ ,  _ MONTH _ ,  and  _ YEAR _ are  expanded  to  the  numerical  day  of  the  month, 

the  name  of  the  month,  and  the  year  including  the  century  for  the  day  on  which  pre  is  run.  This 
generates  a  “time  stamp”  on  the  output,  e.g.,  30  April  1989.  The  preassigned  macro 
_ OPTIONS _ on  the  second  line  is  expanded  to  the  set  of  option  identifiers  assigned  at  pre 


'  Backslash  followed  by  newline  can  be  used  to  extend  a  pre  directive  cosmetically  over  more  than  one  line.  This  is 
allowed  anywhere  that  whitespace  is  allowed. 


invocation  -  separated  by  spaces,  and  followed  by  =  and  assigned  value  for  those  which  are 
assigned  with  the  -a  argument  rather  than  simply  set  with  the  -s  argument.  The  idea  is  to  put  an 

'  ‘options  stamp”  on  the  output.  However,  _ OPTIONS _ alone  would  not  do  this,  for  as  soon 

as  it  was  expanded  to  the  set  of  assigned  option  identifiers,  the  expansion  itself  would  be  scanned 
for  macros,  and  the  option  identifiers  would  be  expanded  to  their  values,  (pre  is  like  C  preproces¬ 
sors  in  this  respect.)  The  $  identifiers  construct  overcomes  this  obstacle.  An  identifier  such  as 

_ OPTIONS _ surrounded  by  $’s  is  scanned  only  once  ($-$  is  quasi-mnemonic  for  “single- 

scan”);  if  the  identifier  has  a  macro  expansion,  the  expansion  is  not  scanned. 

The  next  block  of  seven  lines  takes  care  of  defining  the  top-level  predicate  for  the  benchmark.  If 
option  BENCH  is  set,  then  the  interface  to  the  bench  in  set-up .  nreverse  is  included  in  the 
output.  (Remember,  .  nreverse  .  bench  is  a  symbolic  link  to  set-up  .  nreverse.) 
set-up .  nreverse  is  listed  in  Figure  2  (p.  10).  The  final  pre  directive  in  this  file  causes  the 
bench  driver  to  be  included  in  the  output.  Note  that  (1)  whether  BENCH  is  set  or  not,  the  top- 
level  predicate  for  the  benchmark  is  the  first  executable  Prolog  in  the  output,  and  (2)  the  name  of 
this  predicate  is  the  name  of  the  benchmark,  and  the  arity  of  this  predicate  is  zero  -  in  this  case,  it 
is  nreverse/ 0.  These  are  characteristics  not  only  of  nreverse  but  of  every  benchmark  in 
the  suite. 

The  final  block  of  twenty  lines  defines  the  benchmark  itself.  The  DUMMY  option  is  explained  by 
the  documentation  string  specified  by  the  option  directive.  A  DUMMY  option  of  this  sort  is 
provided  for  every  benchmark  in  the  suite.  The  style  of  the  documentation  text  -  indented  eight 
spaces  from  the  left  and  bordered  on  the  left  by  a  column  of  >’s  and  another  column  of  spaces  - 
is  typical  for  the  whole  suite.  Note  that  the  structure  of  the  ‘dummy’  call  which  is  generated 
when  DUMMY  is  set  is  identical  to  that  of  the  ‘dummy’  call  indicated  for  the  bench  by  the 
benchmark/4  clause  in  set-up .  nreverse.  This  compatibility  is  also  a  characteristic  of 
every  benchmark  in  the  suite. 

Figures  3-5  (pp.  11-13)  indicate  the  results  of  MAKE' ing  the  nreverse  benchmark  with  vari¬ 
ous  arguments  and  options.  In  figure  3, 

MAKE  -f  nreverse. m  -D  -L 

generates  the  documentation  text  shown  (-D  argument)  and  writes  the  “options  list”  file 
.nreverse. option  for  subsequent  use  by  MAKE  (-L  argument).  No  Prolog  output  is  generated. 
The  first  block  of  documentation  text  and  the  first  six  options  listed  in  .nreverse. option  are 
specified  by  the  option  directive  near  the  beginning  of  the  bench  driver  (see  Appendix  F). 
(Note  that  if  nreverse  ,m  is  the  only  file  in  the  directory  named  with  a  ,m  extension,  as  is  in 
fact  the  case  in  the  current  on-disk  configuration  of  the  suite,  then  the  -f  nreverse  ,m  argu¬ 
ment  is  not  strictly  necessary  -  MAKE  will  assume  the  first  and  only  “  .m”  file  in  the  directory  to 
be  the  input.  Note  also  that  MAKE  is  not  sensitive  to  the  order  in  which  arguments  are  given  to 
it.) 

In  figure  4, 

MAKE  -f  nreverse. m  -o  nreverse.pl 

generates  Prolog  output  in  nreverse.pl.  This  is  the  plain,  “no-frills”  version  of  the 
nreverse  benchmark.  For  most  of  the  benchmarks  in  the  suite,  MAKE  with  no  options  pro¬ 
duces  such  a  version. 

In  figure  5, 

MAKE  -f  nreverse. m  B  C 
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#  /  * 

set-up . nreverse :  bench  set-up  for  nreverse 
*/ 

nreverse  :-  driver (nreverse) . 

benchmark (nreverse, 

nreverse ( [1, 2 , 3, 4 , 5, 6, 7 , 8, 9, 10, 11, 12, 

13,14,15,16,17,18,19,20,21, 

22, 23, 24, 25, 26,  27, 28, 29, 30 ],_), 
dummy ([1,2,3,4,5,6,7,8,9,10,11,12, 

13, 14, 15, 16, 17, 18, 19, 20,21, 

22, 23, 24, 25, 26,  27, 28, 29,  30 ],_), 

1000)  . 

show (nreverse)  :-  nreverse ( [ 1 , 2 , 3 , 4 , 5, 6, 7 , 8 , 9 , 10 , 1 1 , 12 , 

13, 14, 15, 16, 17, 18, 19, 20, 21, 

22, 23, 24, 25, 26, 27, 28, 29, 30 ] , R) , 
write (' reverse  of'),  nl, 
write ( [1,2, 3, 4, 5, 6,7, 8, 9, 10, 11, 12, 

13, 14, 15, 16, 17, 18, 19, 20, 21, 
22,23,24,25,26,27,28,29,30]),  nl, 
write  (is) ,  nl, 
write (R) ,  nl . 


#include  "driver" 


Figure  2 


generates  Prolog  output  which  includes  the  bench  with  an  appropriate  definition  for 
get_cpu_time/2.  This  time  the  output  is  in  out  .pi;  MAKE  writes  to  this  file  by  default 
when  no  file  is  specified  with  the  -o  argument.  Note  the  “options  stamp”  at  the  top.  Note  also 
how  MAKE  has  resolved  the  ambiguous  prefix  B  io  BENCH,  the  first  match  in  .nreverse.option. 

Suppose  we  want  Prolog  output  for  nreverse  incorporating  the  functionality  of  the  bench 
predicate  show/l  but  without  including  the  bench.  This  sort  of  modification  is  fast  and  easy 
withpre.  Figure  6  (p.  14)  is  a  listing  of  a  revised  nreverse  ,m  which  provides  what  we  want 
through  a  new  option,  SHOW.  Figure  7  (p.  15)  indicates  how  to  use  the  new  option.  First, 

MAKE  -f  nreverse. m  -L 
“installs”  it  in  .nreverse.option.  Then, 

MAKE  -f  nreverse. m  SH 

generates  a  new  out .  pi  with  the  new  nreverse/0.  A  SHOW  option  of  this  sort  has  in  fact 
been  added  for  every  benchmark  in  the  suite  for  which  the  bench  predicate  show/1  is  available. 


haygood@vega>  MAKE  -f  nreverse.m  -D  -L 

>  Option  BENCH  includes  the  'bench'  for  execution 

>  time  measurement. 

> 

>  The  'bench'  uses  the  system-dependent  predicate 

>  get_cpu_time/2 .  If  one  of 

> 

>  BIM_PL  C_PL  QUINTUS_PL  SB_PL  SICSTUS_PL 

> 

>  is  selected,  then  an  appropriate  definition  for 

>  get_cpu_time/2  is  generated  automatically. 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (nreverse/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  ;t,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected. 

haygood@vega>  cat  . nreverse . opt  ion 
BENCH 
B I M_P  L 
CJ?L 

QUINTUS_PL 

SB_PL 

SICSTUS_PL 

DUMMY 


Figure  3 


haygood@vega>  MAKE  -f  nreverse.m  -o  nreverse.pl 
haygood@vega>  cat  nreverse.pl 
%  generated:  30  April  1989 
%  option  (s) : 

•  % 

%  nreverse 
% 

%  David  H.  D.  Warren 
% 

%  "naive"-reverse  a  list  of  30  integers 

0  nreverse  nreverse {[ 1, 2, 3, 4 , 5, 6,  7,  8 , 9, 10,  11,  12, 

13,14,15,16,17,18,19,20,21, 

22, 23, 24, 25, 2 6, 27, 28, 29, 30], _) . 

nreverse ( [XI L0] ,L)  nrever se (L0 , LI ) ,  concatenate (LI , [X] , L) . 

nreverse  ([],[]). 

f  concatenate ( [X  I  LI J, L2,  [X  1 1,3 ] )  concatenate (LI , L2 , L3)  . 

concatenate ( [ ] , L, L) . 


Figure  4 
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haygood@vega>  MAKE  -f  nreverse.m 
haygood@vega>  cat  out.pl 
%  generated:  30  April  1989 
%  option (s) :  BENCH  C_PL 

% 

%  nreverse 
% 

%  David  H.  D.  Warren 

% 

%  "naive"-reverse  a  list  of  30 


integers 


nreverse  dr iver (nreverse) . 


benchmark (nreverse, 

nreverse  (  [1,2,  3,  4,5,  6, 3,  8,  9,  10,  11,  12, 
13,  14, 15,  16,  17,  18,  19,20,21, 
22,23,24,25,26,27,28,29,  30) 
dummy  (  [1,2,  3, 4,  5, 6,  7, 8,  9,  10, 11, 12, 

13,  14,  15,  16,  17,  18,  19,  20,21, 

22, 23,  24, 25, 2  6, 27, 28, 29,  30 ),_) 

1000)  . 


show  (nreverse)  nreverse  ( ( 1,  2 , 3 ,  4 , 5,  6,  7 , 8 ,  9,  10,  1 1 , 12 , 

13, 14,  15, 16, 17, 18, 19, 20,21, 

22,  23,  24, 25,  2  6,  2  7,  28,  29,  30  ),R), 
write  (' reverse  of'),  nl, 
write  (  [1,2, 3, 4, 5, 6,7,  8,  9,  10,  11,  12, 

13,  14,  15,  16,  17,  18,  19,  20,21, 
22,23,24,25,26,27,28,29,30)),  nl, 
write (is) ,  nl, 
write(R),  nl. 


%  driver (Name*Iterations) 

%  Call  benchmark/4  to  find  out  the  Action  and  its  Control,  perform 
%  the  specified  number  of  Iterations  of  them,  and  report  the  times. 

driver (Name*Iterations) 

integer (Iterations) , 

Iterations  >=  1, 

t 

benchmark (Name,  Action,  Control,  _) , 
get_cpu_time (TO,  Unit), 

(  repeat ( Iterat ions) ,  call (Action) ,  fail 
;  get_cpu_t ime  (Tl,  Unit) 

)  , 

(  repeat (Iterations) ,  call (Control) ,  fail 
;  get  cpu_time(T2,  Unit) 

)  , 

report (Name,  Iterations,  TO,  Tl,  T2,  Unit). 

%  driver(Name) 

%  Call  benchmark/4  to  find  out  how  many  Iterations  of  the  Action 
%  and  its  Control  to  perform,  perform  them,  and  report  the  times. 

driver(N 

ichmark (Name,  Action,  Control,  Iterations), 

.  _cpu_time (TO,  Unit), 

repeat (Iterations) ,  call (Act  ion) ,  fail 
;  ret_cpu_time  (Tl,  Unit) 

)  . 

(  repeat  ( Iterat  ions)  ,  call  (Control)  ,  fail 
;  get_cpu_time (T2,  Unit) 

)  , 

report  (Name,  Iterations,  TO,  Tl,  T2,  Unit). 
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%  get_cpu_time (T,  seconds)  T  is  one  current  cpu  time 
%  (in  seconds  for  C  Prolog) . 

get_cpu_t ime (T,  seconds)  T  is  cputime. 

%  report (Name,  N,  TO,  Tl,  T2,  Unit) 

%  Take  the  number  of  iterations  and  the  three  times  yielded  by 

%  get_cpu_time/2  and  write  the  total,  overhead,  and  average. 

report  (Name,  N,  TO,  Tl,  T2,  Unit) 

TestTime  is  T1-T0, 

“(TestTime,  Unit,  TesrTime_out ,  Ur.it_out), 

Overhead  is  T2-T1, 

“(Overhead,  Unit,  Overhead_out ,  Unit_out), 

Average_out  is  (TestTimc-_out-Cverbead_out ) /N, 
write  (Name),  write!'  took  '), 

write ( (TestTime_out-Overhead_out ) /N=Average_out ) , 
write('  '),  write  (Unit_out)  ,  wr  ite  ('/ iteration' )  ,  rl. 


%  repeat  (N)  succeed  precisely  N  times. 

%  This  is  designed  solely  for  use  in  this  application;  for  a  general 
%  way  of  doing  this  use  the  standard  library  predicate  between/3,  or 
%  perhaps  repeat/0. 

repeat (N)  N  >  0,  from(l,  N) . 


from(I, 

I)  !. 

from (L, 

U)  M  is 

(L+U)  >>  1, 

f rom (L, 

M!  . 

f rom (L, 

U)  M  is 

(L+U)  >>  1  + 

1,  from(M, 

U)  . 

%  -(Tl, 

Unitl,  T2, 

Unit2)  Tl 

Unitl  =  T2 

Unit2 

%  The  purpose  of  =/4  is  unit  conversion  -  the  intended  usage  is 
%  from  Tl  Unitl  to  T2  Unit2.  In  particular,  the  purpose  is  time 

%  unit  conversion  for  report/6.  Preferentially,  times  convert  to 

%  mi 1 1 i-seconds .  However,  clauses  may  oe  added  to  convert  to  any 

%  unit  aesired. 

■(Tl,  seconds,  T2,  ' mi 1 1 i-seconds ' )  !,  T2  is  Tl*1000. 

=(T,  Unit,  T,  Unit).  %  "catch-all"  identity 


%  Trivial 
dummy . 
dummy  (_)  . 
dummy (_, 
dummy (_, 
dummy  (_, 
dummy  (_, 


predicates 


for 


use 


as  controls. 


nreverse ( [X  I L0 ) , L)  nreverse ( L0 , LI ) ,  concatenate (LI,  [X] , L)  . 
nreverse ( [] , ( ) ) . 

concatenate ( (X | LI J , L2,  [X  I L3 ] )  concatenate (LI, L2, L3) . 
concatenate  (  []  ,  L,  L)  . 


Figure  5 
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#  /* 

nrevecse.m:  Warren  benchmark  nreverse  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s) :  S _ OPTIONS _ S 

% 

%  nreverse 
% 

%  David  H.  D.  Warren 
% 

%  " naive "-reverse  a  list  of  30  integers 

#if  BENCH 

(f  include  " .nreverse .bench" 

((else 

((option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

#  if  SHOW 

nreverse  nreverse  (  [1,  2,  3,  4, 5,  6,  7, 8, 9,  10,  11, 12, 

13,  14,  15,  16,  17, 18, 19,20, 21, 

22, 23,  24, 25, 26, 27, 28, 29, 30 ], R) , 
write  (' reverse  of'),  nl, 
write  ( [1,2,3,  4,5,  6,7,8,  9,  10, 11,12, 
13,14,15,16,17,18,19,20,21, 

22, 23, 24, 25, 26, 27, 28, 29, 30]),  nl, 
write  (  is) ,  nl, 
write (R) ,  nl . 

#  else 

nreverse  nreverse  (  ( 1,  2 , 3 , 4 , 5 , 6,  7 , 8,  9,  10, 11,  12, 
13,14,15,16,17,18,19,20,21, 

22, 23,  24, 25, 26,  27, 28,  29,  30  ],_)  . 

#  endif 
((endif 


((option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (nreverse/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.1 


#if  DUMMY 
nreverse  (_,  _)  . 

((else 

nreverse ( [X | L0 ], L)  nreverse (L0, LI) ,  concatenate (LI, [X] , L) . 
nreverse (  ( ] ,  [ ] )  . 


concatenate ( [X  I  LI] , L2,  [X  I L3 ] )  concatenate (LI, L2, L3)  . 
concatenate ( [ ] , L, L) . 

((endif 


Figure  6 
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haygood0vega>  MAKE  -f  nreverse.m  -L 
haygood@vega>  MAKE  -f  nreverse.m  SH 
haygood@vega>  cat  out.pl 
%  generated:  30  April  1989 
%  option {s):  SHOW 
% 

%  nreverse 
% 

%  David  H.  D.  Warren 

% 

%  "naive"-reverse  a  list  of  30  integers 

nreverse  nreverse ( [1 , 2 , 3 , 4 , 5, 6, 7, 8 , 9, 10 , 11 , 12 , 

13, 14, 15,16, 17, 18, 19,20, 21, 

22, 23, 24,25,26, 27, 28,29, 30] , R) , 
write (' reverse  of'),  nl, 
write  ([1,2, 3, 4, 5, 6, 7, 8, 9,  10, 11, 12, 

13, 14, 15, 16, 17, 18, 19, 20, 21, 
22,23,24,25,26,27,28,29,30]) ,  nl, 
write (is) ,  nl, 
write (R) ,  nl . 

nreverse ( [X I L0] , L)  nreverse  (LO, LI ) ,  concatenate (LI ,  [X] , L)  . 

nreverse ( ( ] , [] ) . 

concatenate ( [X | LI ], L2,  [X  I L3] )  concatenate (LI , L2 , L3)  . 
concatenate ( ( ] , L, L) . 


Figure  7 


4  Future  Work 

There  are  many  potential  improvements  to  the  suite.  These  include: 

•  More  “macroscopic”  benchmarks  -  for  example,  a  serious  expert  system. 

•  Benchmarks  written  with  parallel  execution  in  mind.  There  are  few  of  these  yet.  This  is 
surely  an  important  future  direction. 

•  More  apparatus  for  evaluating  benchmark  performance.  The  present  suite  incorporates  a 
simple  framework  for  execution  time  measurement.  Some  external  performance  analysis 
techniques  are  also  available.  (For  example,  one  can  compile  C  Prolog  with  the  -pg  option, 
run  a  Prolog  benchmark  under  C  Prolog,  and  obtain  an  execution  profile  with  gprof.)  In  the 
future  an  integrated  analysis  “workbench”  such  as  Gauge  [GK88]  may  be  incorporated  into 
the  suite. 

•  More  analysis  of  what  results  for  these  benchmarks  mean  for  Prolog  implementations. 
Benchmarking  is  as  much  art  as  science.  Figuring  out  what  statistics  from  a  set  of  bench¬ 
marks  imply  about  the  multitude  of  decisions  embodied  in  an  implementation  is  a  formid¬ 
able  task.  Important  work  in  this  direction  has  been  done  over  the  last  few  years,  but  more 
is  needed.  There  is  not  yet  any  work  in  Prolog  benchmarking  fully  comparable  to,  say,  R. 
P.  Gabriel’s  work  in  Lisp  benchmarking.  [Gab85] 
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Appendix  A  •  Benchmark  Suite  Catalog 


aspf 

name 

task 

references * 

inverter 

compact  VLSI  inverter  cell 

[Bus88] 

random_logic 

compact  VLSI  random  logic  cell 

[Bus88] 

sml 

synthesize  structural  description 

[Bus88] 

for  simple  microprocessor 

|  berkeley  I 

name 

task 

references 

adder 

design  adder  (with  NAND’s) 

mux1 

design  2-1  MUX  (with  NAND’s) 

[Dob87]  [DSP85] 

concat_l2 

concat  [a,b,c]  to  [d,e] 

[Dob87]  [DSP85] 

concat_63 

nondeterm  inate  list  concatenation 

[DSP85] 

hanoi  84 

8-disk  tower  of  hanoi 

[DSP85] 

hanoi_16 

16-disk  tower  of  hanoi 

mu5 

prove  ^-math  theorem 

[Dob87]  [DSP85]  [NSD88] 

prime  1006 

find  every  prime  <  100 

[DSP85] 

prime_1000 

find  every  prime  <  1000 

queens  4 

4-queens  problem 

queens 8 

8-queens  problem 

_ chat  parser _ 

name _ task _ _ references 

chat_parser  parse  natural  language  [Tic87]  [WP82] 


asp,  berkeley,  chat_parser,  etc.  name  families  of  related  benchmarks. 
*  These  point  to  the  References  section  at  the  end  of  the  main  text. 

1  mux  has  also  been  known  as  ckt2. 

2 

concat  1  has  also  been  known  as  coni. 

3 

concat_6  has  also  been  known  as  con  6. 
hanoi_8  has  also  been  known  as  hanoi. 

5  mu  has  also  been  known  as  mumath  and  mutest. 

6  prime_100  has  also  been  known  as  pri2. 


i  fft 

name 

task 

references 

fft  4 

fast  fourier  transform 

f(x)  =  x  on  16  (=  2*4)  points 

fft  8 

fast  fourier  transform 

f(x)  =  x  on  256  (=  2*16)  points 

|  gabriel 

name 

task 

references 

boyer 

prove  arithmetic  theorem 

[Gab85]  [Pon89]  [Tic86] 

browse 

build  and  query  database 

[Dob87]  [Gab85]  [Pon89] 

poly  5 

raise  1+x+y+z  to  5th  power 

[Gab85]  [Pon89] 

poly  10 

raise  1+x+y+z  to  10th  power 

[Gab85]  [Pon89] 

poly_15 

raise  1+x+y+z  to  15th  power 

[Gab85]  [Pon89] 

puzzle 

solve  geometric  puzzle 

[Gab85]  [Pon89]  [Tic86] 

tak 

recursive  arithmetic 

[Gab85]  [Pon89]  [Tic86] 

1 _ ili _ 1 

name 

task 

references 

! 

natural  deduction  theorem  proving 

[Tic87] 

2 


ereira 


pereira 

name 

task 

references 

floating  add 

100  floating  point  additions 

[Bur87]  [Qui88] 

intege r_add 

100  integer  additions 

[Bur87]  [Qui88] 

arg  1 

100  calls  to  argument  at  position  1 

[Bur87]  [Qui88] 

arg  2 

100  calls  to  argument  at  position  2 

[Bur87]  [Qui88] 

arg  4 

100  calls  to  argument  at  position  4 

[Bur87]  [Qui88] 

arg  8 

100  calls  to  argument  at  position  8 

[Bur87]  [Qui88] 

a  rg_l 6 

100  calls  to  argument  at  position  16 

[Bur87]  [Qui88] 

assert  unit 

assert  1000  clauses 

[Bur87]  [Qui88] 

access_unit 

access  100  (dynamic)  clauses 
with  1st  argument  instantiated 

[Bur87]  [Qui88] 

slow  access  unit 

access  100  (dynamic)  clauses 
with  2nd  argument  instantiated 

[Bur87]  [Qui88] 

shallow  backtracking 

99  shallow  failures 

[Bur87]  [Qui88] 

deep_backt racking 

99  deep  failures 

[Bur87]  [Qui88] 

tail  call  atom  atom 

100  determinate  tail  calls 

[Bur87]  [Qui88] 

binary_call_atom_atom 

63  determinate  nontail  calls, 

64  determinate  tail  calls 

[Bur87]  [Qui88] 

choice_point 

push  100  choice  points 

[Bur87]  [Qui88] 

trail_variables 

push  100  choice  points, 
trail  100  variables 

[Bur87]  [Qui88] 

index 

100  first-argument-determinate  calls 

[Bur87]  [Qui88] 

cons  list 

construct  100-element  list,  nonrecursively 

[Bur87]  [Qui88] 

walk  list 

walk  down  100-element  list,  nonrecursively 

[Bur87]  [Qui88] 

walk_list__rec 

walk  down  100-element  list,  recursively 

[Bur87]  [Qui88] 

args_2 

walk  down  2  copies  of  a  100- 
element  list,  recursively 

[Bur87]  [Qui88] 

args_4 

walk  down  4  copies  of  a  100- 
element  list,  recursively 

[Bur87]  [Qui88] 

args_8 

walk  down  8  copies  of  a  100- 
element  list,  recursively 

[Bur87]  [Qui88] 

args_16 

walk  down  16  copies  of  a  100- 
element  list,  recursively 

[Bur87]  [Qui88] 

setof 

setof  (X,  Y'prfX,  Y)  ,  ) 

[Bur87]  [Qui88] 

pair_setof 

setof  ((X,  Y),  pr  (X,  Y)  ,  _) 

[Bur87]  [Qui88] 

double_setof 

setof((X,  S) ,  setof  (Y,  pr(X,  Y)  ,  S)  ,  _) 

[Bur87]  [Qui88] 

bagof 

bagof (X,  Y'prfX,  Y) ,  _) 

[Bur87]  [Qui88] 

cons_term 

construct  100-node  term,  nonrecursively 

[Bur87]  [Qui88] 

walk_term 

walk  down  100-node  term,  nonrecursively 

[Bur87]  [Qui88] 

walk_term  rec 

walk  down  100-node  term,  recursively 

[Bur87]  [Qui88] 

medium_unify 

unify  structures  5  deep 

[Bur87]  [Qui88] 

deep unif y 

unify  structures  1 1  deep 

[Bur87]  [Qui88] 

3 


|  plm  compiler 

name  task 

references 

plm  compiler  compile  small  Prolog  file  to  PLM  code 

[Tic87]  [Van84] 

l  _ tp _ 

name 

task 

references 

boys 

prove  propositional  theorem 

ct  2 

prove  propositional  theorem 

ct  3 

prove  propositional  theorem 

ct  4 

prove  propositional  theorem 

ct  5 

prove  propositional  theorem 

ct_6 

prove  propositional  theorem 

|  warren 

name 

task 

references 

divide 10 
loglO 
ops  8 
timeslO 

symbolic  differentiation 
symbolic  differentiation 
symbolic  differentiation 
symbolic  differentiation 

[Dob87]  [DSP85]  [NSD88]  [War83] 
[Dob87]  [DSP85]  [War83] 

[Dob87]  [DSP85]  [War83] 

[Dob87]  [DSP85]  [NSD88]  [War83] 

nreverse7 

reverse  30-element  list 

[Dob87]  [DSP85]  [War83] 

qsort8 

quicksort  50-element  list 

[Dob87]  [DSP85]  [War83] 

query 

query  small  database 

[Dob87]  [DSP85]  [NSD88]  IWar83] 

serialise9 

itemize  25-element  list 

[Dob87]  [DSP85]  [War83] 

nreverse  has  also  been  known  as  nrev. 


8 

9 


q sort  has  also  been  known  as  qs4. 
serialise  has  also  been  known  as  pal  in2  5. 
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Appendix  B  •  Execution  Times 


I  .  _ asp  _  _  _ 1 

name 

* 

Quintus  Prolog 

C  Prolog * 

inverter 

2320 

4220 

random_logic 

26700 

92200 

sml 

3960 

3320 

|  berkeley 

name 

Quintus  Prolog 

C  Prolog 

adder 

2150 

13700 

mux 

31.3 

225 

concat  1 

0.017 

1.03 

concat_6 

0.372 

3.20 

hanoi  8 

19.8 

282 

hanoi_16 

5060 

72400* 

mu 

64.9 

615 

prime  100 

50.0 

723 

prime_1000 

1680 

22800* 

queens  4 

3.70 

63.8 

queens_8 

127 

2900 

!  chat  parser  | 

name 

Quintus  Prolog 

C  Prolog 

chat_parser 

3590 

33600 

fft  | 

name 

Quintus  Prolog 

C  Prolog 

fft  4 

55.8 

484 

fft_8 

1790 

I  - 

Execution  time  in  milli-seconds  for  Quintus  Prolog  2.0  (compiled)  on  a  Sun  3/60,  to  three  significant  figures  (in  most  cases), 
averaged  over  many  iterations.  A  '?’  indicates  the  benchmark  did  not  terminate  within  several  hours. 

Execution  time  in  milli-seconds  for  C  Prolog  1 .5  on  a  Sun  3/60,  to  three  significant  figures  (in  most  cases),  averaged  over  many 
iterations,  'memory'  indicates  failure  due  to  one  memory-related  problem  or  another. 

These  consume  more  memory  than  C  Prolog  allocates  by  default,  but  they  will  run  if  global  stack  size  and/or  local  stack  size  is 
manually  enlarged.  Three  Mbytes  each  is  adequate. 


|  gabriel 

name 

Quintus  Prolog 

C  Prolog 

boyer 

18200 

memory 

browse 

23300 

347000* 

poly_5 

105 

1050 

poly  10 

1420 

14600* 

73300* 

poly_15 

7200 

puzzle 

10500 

27600 

tak 

3300 

73000* 

L  ili  _ 1 

name 

Quintus  Prolog 

C  Prolog 

ill 

1310 

13000 

|  pereira  | 

name 

Quintus  Prolog 

C  Prolog 

floating  add 

5.43 

75.7 

integer_add 

1.32 

76.3 

arg  1 

3.04 

57.0 

arg  2 

3.06 

57.0 

arg  4 

3.05 

57.0 

arg  8 

3.06 

57.0 

arg_16 

3.08 

57.0 

assert  unit 

2 180 

1040 

access  unit 

24.7 

623 

slow_access_unit 

798 

873 

shallow  backtracking 

0.917 

7.97 

deep_backt racking 

1.83 

32.7 

tail  call  atom  atom 

0.850 

13.7 

binary  call  atom  atom 

1.34 

17.6 

choice_point 

1.73 

13.8 

trail_variables 

2.45 

16.3 

index 

1.39 

458 

cons  list 

1.35 

15.5 

walk  list 

0.708 

19.2 

walk  list  rec 

0.550 

25.9 

args_2 

1.03 

34.7 

args  4 

1.77 

52.1 

args_8 

3.89 

86.6 

args  16 

7.72 

156 

setof 

162 

1700 

pair  setof 

163 

1740 

double  setof 

522 

3690 

bagof 

96.7 

516 

cons  term 

1.51 

15.4 

walk  term 

1.03 

19.3  . 

walk_term_rec 

0.875 

25.9 

medium  unify 

1.13 

3.93 

deep unif y 

75.3 

256 
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Appendix  C  •  Prolog  Features 


Prolog  Feature  Classes* 

class 

features 

1 

cut [ ! ] 

2 

disjunction  [P  ;  Q] 

3 

if-then  [P  ->  Q] 

4 

simple  integer  arithmetic  [X  is  Y+l,x  is  Y-l,  X  =:=  Y,  X  <  Y,etc.]+ 

5 

less  simple  integer  arithmetic  [X  is  Y+z,  Y*z,  Y«Z,  Y/\z,  etc.]* 

6 

floating  point  arithmetic 

7 

structure  manipulation  [functor/ 3,  arg/3,  =.  .12} 

8 

constant-text  conversion  [name/  2] 

9 

database  editing  [assert/1,  retract/1,  abolish/2] 

10 

term  comparison  [T 1  ==  T2.T1  @<  T2,etc.] 

11 

negation-by-failure  ( \  +  P  ] 

12 

call/1 

13 

reading  [get  / 1,  read/ 1,  etc.] 

14 

writing  [put/l,  write/1, etc.]* 

*  Vote  also: 

(1) The  asp  benchmarks  use  cor.su !  t  / 1;  if  this  is  inconvenient,  the  files  they  consult  can  be  *  inc  lude’d  instead. 

(2)  setof/3and  baqo  f  /  3  are  used  only  by  the  pereira  benchmarks  setof,  paicsetof,  doubieseco : ,  and 
cage  f  which  focus  on  them. 

(3)  No  benchmark  in  the  suite  uses  grammar  rules. 

+  Precisely,  "simple  integer  arithmetic"  is  arithmetic  comparison  (X  =:=  Y,  X  =\=  Y,  X  <  Y,  X  >  Y,  X  =  <  Y,  X  >- 
Y)  with  integer  operands  and  increment  or  decrement  by  1  (X  is  Y+l,  X  is  Y-l)  with  an  integer  operand.  Many  bench¬ 
marks  need  only  these  arithmetic  features.  "Less  simple  integer  arithmetic”  is  any  other  arithmetic  with  integer  operands 
except  division  (X  is  Y/Z),  whose  result  is  always  floating  point. 

*  Benchmarks  which  offer  the  SHOW  option  are  noted  as  requiring  these  features  only  if  they  use  put/l,  wr  ice/  1,  etc.  even 
when  SHOW  is  not  selected. 


inverter 

random_logic 

sml 


,i 


li 


•  ••••• 

•  ••••• 

•  •  •  • 


berkeley 

name 

1  2 

3  4  5  6 

7  8  9  10  11  12  13  14 

adder 

• 

• 

mux 

• 

• 

concat_l 
concat_6 
hanoi  8 

• 

• 

hanoi_16 

• 

• 

mu 

prime__100 

• 

• 

•  • 

• 

prime  1000 

• 

•  • 

• 

queens  4 

• 

•  • 

• 

queens 8 

• 

•  • 

• 

chat 

parser 

name 

12  3  4 

5  6  7  8  9  10  11  12  13  14 

chat_parser 

J  r1 2 

1 _ _ _ «t _  1 

name 

1  2 

3  4  5 

6  7  8  9  10  11  12  13  14 

fft  4 

• 

• 

• 

fft_8 

• 

• 

• 

1  These  features  (disjunction  and  if-then)  are  used  only  in  connection  with  showing  what  sml  does  (with  the  SHOW  option  or 
with  the  bench  predicate  show/1).  They  can  be  removed  easily. 

2 

These  features  (cut  and  simple  integer  arithmetic)  are  each  used  exactly  once  in  chat  parser.  They  can  be  removed  easiiy. 


i 


abriel 


J  6  7  8  9  10  11  12  13  14 


C  *3 


|  plm  compiler 

name 

1  2  3  4  5  6  7  8  9  10  11  12  13  14 

plm compiler 

tp 

name 

1 

2 

3 

4 

5  6 

7  8 

9  10 

11 

12  13  14 

boys 

0 

• 

0 

0 

• 

0 

0 

0 

0 

ct  2 

• 

• 

• 

• 

• 

• 

0 

0 

0 

ct  3 

• 

• 

• 

• 

0 

0 

0 

0 

0 

ct_4 

• 

• 

• 

• 

• 

0 

0 

0 

0 

ct  5 

• 

• 

• 

• 

• 

0 

0 

0 

0 

ot_6 

• 

• 

• 

• 

• 

0 

0 

0 

0 

warren 

name 

1  2 

3  4  5  6  7  8  9  10  11  12  13  14 

dividelO 

0 

loglO 

0 

ops  8 

• 

timeslO 

• 

nreverse 

qsort 

• 

0 

query 

0  0 

serialise 

• 

0 

3  These  features  (disjunction  and  database  editing)  are  necessary  for  puzzle  only  with  Prolog  systems  which  do  not  support 

set/2and  access/2  (see  puzzle. m). 
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Appendix  D  mpre 


I 

Makefile 

pre . c  . 

pre . yacc 
pre .  lex  .. 


» 


I 


» 


Makefile 


pre:  pre.c  y.tab.c  lex.yy.c 
gcc  -o  pre  pre.c  -11 
rm  -f  y.tab.c 
rm  -f  lex.yy.c 

y.tab.c:  pre.yacc 

yacc  pre.yacc 

lex.yy.c:  pre. lex 

lex  pre. lex 


Del 


♦include  <ctype.h> 
♦include  <staio.h> 
♦include  <string.h> 

/*  for  set_lex_start 
♦define  Normal  0 
♦define  Mark  1 
♦define  Assign  2 


pre .  c 


♦define  YES 
♦define  NO 


/*  prototypes  */ 

void  set  lex  start (int  start  condition); 


/*  variables  */ 

FILE  *infp  =  stdin,  'outfp  =  stdout; 

int  normal_scan  -  YES,  document_scan  ~  NO,  list_scan 

main(int  argc,  char  *argv[]) 

{ 

/*  prototypes  */ 

void  process_args (int  argc,  char  *arg v[]); 
void  assign_predefined (void)  ; 
int  yyparse (void) ; 

/*  process  command-line  arguments  */ 
process_args (argc,  a rgv) ; 

/*  assign  predefined  macros  */ 
if  (normal_scan)  assign_predef inedO  ; 

/*  initialize  lexical  analyzer  */ 
set_lex_start (Normal) ; 

/*  process  file  */ 
yyparse  ()  ; 

) 

char  *st rdup (char  *s)  /*  duplicate  string  V 

; 

char  *p; 

p  =  (char  *)  malloc  (strlen  (s)  +1)  ; 
if  (p  !  =  NULL) 
strcpy  (p,  s)  ; 
return  p; 

} 

♦define  HASHSIZE  107 

static  struct  nlist  *mactab (HASHSIZE] ; 

unsigned  hash (char  *s) 

{ 


unsigned  h 


0; 


while(*s)  { 

if  (isdigit (*s) ) 

h  =  63*h  +  (*s-' 0' ) ; 
else  if  (isupper  (*s)  ) 

h  -  63*h  +  ( *s-' A' +10) ; 
else  if  (islower (*s) ) 

h  =>  63*h  +  (*s-'a'  +36!  ; 
else  /*  *s  ==  ' */ 
h  *  63*  (h  +  1)  ; 

s  +  +  ; 

) 

return  h  %  HASHSIZE; 


NO 
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struct  niist  {  /*  macro  table  entry  */ 

struct  niist  'next;  /*  next  entry  in  bucket 
char  ‘name;  /*  macro  name  */ 

char  ’•expansion;  /*  macro  expansion  */ 

)  ; 


struct  niist  'lookup (char  *s) 

{ 

struct  niist  *np  =  mactab [hash (s) ] ; 

while (np  /*  !=  NULL  */) 

if  (strcmp(s,  np->name)  ==  0) 
return  np; 

else 

np  =  np->next; 
return  NULL; 

) 

char  'assign (char  'name,  char  'expansion) 

( 

struct  niist  'np  =  lookup (name) ; 
unsigned  h; 

if  (np  ==  NULL)  (  /*  NOT  found  */ 

np  =  (struct  niist  *)  malloc ( s izeof ( *np) ) ; 
if  (np  ==  NULL  II  (np->name  =  strdup (name) ) 
return  NULL; 
h  =  hash  (name); 
np->next  =  mactab [h] ; 
mactab (h]  =  np; 

)  else  /'  found  */ 

free (np->expansion) ; 

return  np->expansion  =  strdup (expansion) ; 

> 


NULL) 


char  'expand (char  'name) 

{ 

struct  niist  *np  =  lookup (name) ; 

return  (np  /*  !=  NULL  */)  ?  np->expansion  :  NULL; 

I 

Idefine  isunder(c)  c  ==  ' 

char  *get_identlf ier (char  *s) 

( 

int  i  =  1; 
char  *p; 

if  ( ! (isalpha (*s) 
return  NULL; 

while  ( isalnum(* (s+i) )  II 
i  +  +  ; 

p  =  (char  *)  malloc(i+l); 
if  (p  ! =  NULL)  ( 
strncpyfp,  s,  i); 

'(p+i)  =  NULL; 


> 

return  p; 


isunder  (*s)  ) ) 

isunder  (*  (s+i)  !  ) 


/*  this  IS  necessary  */ 
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:ia  process  args(int  argc,  char  *argv[]) 


inc  i  =  0; 
char  c; 
char  "name; 

char  options  i  1024  ]  =  {  '\0'  );/*  clumsy  but  adequate  */ 


while  ( — argc  >  0  SS  *argv[++i]  == 
switch  (c  =  *++argv[i])  { 

case  ' a'  : 

name  =  get_ident if ier (++argv i i] ) ; 

if  (name  ==  NULL  II  (c  =  *(argv[i]  +=  strlen (name) ) ) 
fprintf (stderr,  "Usage:  pre  -aname=expansion\n" ) ; 
exit  (-1 )  ; 


assign(name,  +->-argv  (  i  ]  )  ; 
strcat (options,  "  "); 
st rcat (opt  ions ,  name); 
strcat (options,  “=“) ; 
strcat (opt ions,  argv(il); 
free (name) ; 
break; 
case  ' s' : 

name  =  get_identifier (++argv[i 
if  (name  ==  NULL)  ( 

fprintf (stderr,  "Usage:  pre 
exit (-1)  ; 


]>; 

-sname\n")  ; 


{ 


assign(name,  "1"); 
strcat (options,  “  “); 
strcat (options,  name) ; 
free (name) ; 
break; 
case  ' D' : 

normal_scan  =  NO; 
document_scan  =  YES; 
break; 
case  ' L' : 

r,ormal_scan  =  NO; 
list_scan  =  YES; 
break; 
default : 

fprintf  (stderr,  "Illegal  option  %c\n",  c) ; 
exit  (-1)  ; 

) 

if  (argc  !=  0)  ( 

fprintf (stderr,  "Usage:  pre  { — D ]  [-L]  ( ~aname=expansion ] 

exit  (-1)  ; 

} 

if  (normal_scan  SS  ! lookup (" _ OPTIONS _ ")) 

if  (strlen (options)  /*  !=  0  */) 

assign ( " _ OPTIONS _ ",  options+1) ; 

else 

assign (" _ OPTIONS _ ",  ”“); 


( -sname ] \n” ) 


D  *4 


♦include  <sys/time.h> 
void  assign_predef ined ( void) 

char  *mname ( ]  =  < 

“January" , 

"February", 

"March", 

"April", 

"May", 

"June" , 

"July", 

" August" , 

"September", 

"October" , 

"November", 

"December" 


struct  timeval  *tvp  =  (struct  timeval  *)  malloc (sizeof (struct  timeval) ) 
struct  tm  *tmp; 
char  buf [5] ; 

/*  TIME  MACROS  */ 

gettimeofday (tvp,  NULL); 

tmp  =  localtime (Stvp->tv_sec)  ; 

/*  month  name  abbreviation  (three-letter)  */ 

if  (! lookup ("  MABB3 "))  ( 

buf [3]  =  ’ \0'  ; 

assign ( " _ MABB3 _ ",  strncpy(buf,  mname [tmp->tm_mon] ,  3)); 

} 

/*  day  of  the  month  V 

if  (!  lookup!" _ MDAY _ ••)  )  ( 

sprintf(buf,  "%u",  tmp->tm_mday) ; 
assign  (" _ MDAY _ ",  buf)  ; 

} 

/*  month  name  (full)  ’/ 

if  (! lookup (" MONTH ">) 

assign ( " _ MONTH _ " ,  mname ( tmp->tm_mon) ) ; 

/*  year  including  century  */ 

if  (! lookup !" _ YEAR _ "))  { 

sprintftbuf,  "%u",  1900+tmp->tm_year) ; 
assign  (" _ YEAR _ ",  buf)  ; 


/*  year  not  including  century  */ 

if  (!  lookup!" _ YABB2 _ "))  ( 

sprintftbuf,  "iu”,  tmp->tm_year%100)  ; 
assign ( " _ YABB2 _ ",  buf) ; 

) 

) 


void  yyerrorlchar  *s) 

( 

fpr  intf  (stderr,  "%s\n”,  s)  ; 

) 


♦include  "y.tab.c 


%i 

pre . yacc 

/*  prototypes  */ 

void  include (char  *fname) ; 

void  setup  if (int  condition); 
void  continue  if(int  condition); 
void  wrapup_if (void) ; 
char  ’dequote (char  *s)  ; 

/*  variables  */ 
static  int  eliding  =  NO; 
static  int  expanding  ~  YES; 
static  char  linbuf [2048] ; 

%) 

%start  lines 

%union  i  int  i; 

char  *s; 

i 

%token  <i>  INTEGER 
%token  <s>  GENERIC 
%token  <s>  IDENTIFIER 

%token  <s>  STRING 
%token  AND 
%token  ASSIGN 
%token  CLEAR 
%token  DEFINE 
%token  ELIF 
%token  ELSE 
%token  ELSEIF 

%token  ENDIF 
%token  EQ 
%token  ERROR 
%token  GE 
%token  GT 
%token  HALT 
%token  IF 
%token  IFDEF 

%tok en  IFNDEF 
%token  INCLUDE 
%token  LE 
%token  LT 
%token  MARK 
%token  MESSAGE 
%token  ME 
%token  NOT 

%token  OPTION 
%token  OR 
%token  SET 

%type  <i>  conditional_expression 
%type  <i>  equality  expression 
%type  <i>  logical  AND_expression 
%type  <i>  logical  NOT_expression 

%type  <i>  logical  OR  expression 
%type  <i>  primary  expression 
%type  <i>  relational_expression 
%type  <s>  generics 
%type  <s>  non_control_line 

D  *6 
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%% 

lines  : 

I 

line  : 

non_control_line 

generics  : 

I 

control  line 


assignment__line 

assign_line  : 


assign_token 

set  line 


line 

lines  line 


non_control_line 

{  if  ([eliding  ii  normal_scan)  fputs($l,  outfp); 
control  line 


) 


generics  ' \n' 

{  SS  =  ([eliding  it  normal_scan)  ? 
strcat ($1,  "\n")  :  NULL;  ) 


/*  empty  */ 

(  SS  =  ([eliding  a  normal_scan) 
strcpy (linbuf,  "“)  :  NULL;  i 

generics  GENERIC 

{  S$  =  ([eliding  it  normal_scan) 
strcat  ($1,  $ 2 )  :  NULL;  } 


assignment_line 
comment_l ine 
error_line 
halt_line 
include_line 
message_line 
opt ion_line 
conditional 


assign_line 
set_line 
clear  line 


mark 

ass  ign_token 

{  expanding  =  NO;  } 

IDENTIFIER 

{  set_lex_start (Assign) ;  } 
generics 
norm 

(  expanding  =  YES; 

if  ([eliding  a  normal_scan) 

{  assign (S4,  S6) ;  free ($4); 


) 


ASSIGN 

DEFINE 


mark 

SET 

(  expanding  =  NO;  ) 

IDENTIFIER 

norm 

(  expanding  =  YES; 

if  ([eliding  t t  normal_scan) 

(  assign  (54,  "l");  free ($4); 


)  ) 
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ciear_line  :  mark 

CLEAR 

{  expanding  =  NO;  } 

IDENTIFIER 

norm 

{  expanding  =  YES; 

if  ((eliding  44  normal_scan) 

{  assign($4,  "O")  ;  free ($4);  }  ) 


comment  line 


mark  norm 


error  line 


mark 


ERROR 

{  set_iex_5tart  {Normal)  ;  ) 
generics 
'  \n' 

<  if  ('eliding  44  normal_scan) 

\  fprintf  (stderr,  "ls\n",  S4+strspn  ($4 , 
exit (0) ;  )  ) 


\t")  )  ; 


halt  line 


mark  HALT  norm 

{  if  ({eliding  44  normal_scan)  exit(0);  ) 


include  line 


mark  INCLUDE  STRING  norm 

{  if  ((eliding)  include (dequote ($3) ) ;  free ($3);  ) 


message_line 


mark  MESSAGE  STRING  norm 

(  if  ((eliding  44  normal_scan) 

fprintf (stderr,  "%s\n",  dequote (S3 ) ) ;  free (S3);  ) 


option_l ine 


mark 

OPTION 

{  expanding  =  NO;  ) 
option_list 

(  expanding  =  YES;  ) 
document_part 
norm 


option_list  :  /*  empty  */ 

I  option_list  IDENTIFIER 

(  if  (list_scan)  fprintf (outfp,  "%s\n”,  $2);  free ($2);  } 

document_part  :  /*  empty  */ 

!  STRING 

(  if  (document_scan) 

fprintf (stderr,  "%s\n",  dequote (SI) ) ;  free(Sl);  ) 


conditional 


if_part 

if_part 

if_part 

if_part 


lines  endif_part 

lines  else_part  lines  endif_part 

lines  elseif_parts  lines  endif_part 

lines  elseif_parts  lines  else_part  lines  endif_part 
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-f_par: 


else  oar: 


r,a:<  IF  ccr.air  Iona  .^express  ion  norm 

{  if  (normal  scan)  setup__if  ($3)  ;  } 

rr.ar.< 

"FD^F 

(  expanding  =  NO;  f 
IDENTIFIER 
norm 

{  expanding  =  YES; 

if  (normal_scan)  setup_i f ( lookup ( S 4 )  !«  NULL);  free($4);  ) 

mark 

IFNDEF 

(  expanding  =  NO;  } 

IDENTIFIER 
no  rm 

•  expanding  =  YES; 

if  (norraal_scan)  setup_i f ( lookup ! S4 )  ==  NULL);  free(S4);  • 


marx  ELSE  norm 

(  if  (normal  scan)  continue  if(l);  ) 


else! f_parts 


elseif  part 


elself  token 


endif_part 


elseif_part 

elseif_parts  lines  elseif_part 


mark  elseif_token  conditional_expression  norm 
(  if  (normal  scan)  continue  if (S3);  ) 


:  ELSEIF 

I  ELIF 


mark  ENDIF  norm 

(  if  (normal_scan)  wrapup_if();  } 


condit ional_expression  :  logical_OR_expression 


logicai_OR_express ion 


logica  l_AND_expression  : 


logical_AND_exptession 

logical_OR_expression  OR  logical_AND_expressicr 
(  SS  =  SI  I  I  S3;  ) 


I  1 


logical_NOT_expression 

iogical_AND  expression  AND  logical_NOT_expression 
{  SS  =  SI  SS  S3;  ) 


logical_NOT_expression  :  equality_expression 

I  NOT  equality_expression 


equal ity_expression 


(  SS  =  !$2;  ) 


relat ional_expression 

equality_expression  EQ  relat ional_express ion 
{  SS  -  SI  ==  S3;  } 

equality_expression  NE  re lat ional_expression 
(  SS  =  $1  !=  S3;  ) 
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i_expression 


primary_exp session 
relationai_expression  LT 
{  SS  =  Si'  <  $3;  } 
relat ional_expression  GT 
(  SS  =  Si'  >  $3;  } 
relational_expression  LE 
{  SS  =  SI  <=  $3;  } 
relational_expression  GE 
{  SS  =  $1  >=  $3;  } 


primary_express ion 
primary__express  ion 
primary_express ion 
primary_expression 


primary_expression 


INTEGER 

IDENTIFIES 

{  free (SI) ;  SS  =  0;  } 

'  ('  conditional  expression  ')' 

(  SS  =  $2;  T 


norm 

%% 


MARK  (  set_lex_start (Mark) ;  }  ; 

'0  (  set_lex_start  (Normal)  ;  )  ; 


static  char  ’inpath  =  /’  (/-terminated)  input  path  */ 

char  'path  (char  'fspec)  /'  return  (/-terminated)  path  */ 

{ 

char  *p  =  strdup (fspec) ; 
char  'q  =  p  +  strlen (fspec); 


while  (q  !=  p  is  '( — q)  !=  '/') 
'q  =  NULL; 
return  p; 


} 

char  'fspecfchar  'path,  char  'fnarne) 

( 


char  'q,  'r ; 

if  ('fname  ==  '/')  /’  absolute  f 

q  =  strdup (fname) ; 
else  i 


ie  specification  */ 


q  =  (r  =  (char  *)  malloc (strlen (path) +strlen (fname) +1) ) ; 
if  (r  /»  !»  NULL  '/)  ( 

while  (*r  =  *path++)  C++; 
while  (*r++  =  *fname++)  ; 


) 


) 

return  q; 


typedef  struct  f_frame  ( 
struct  f_frame  'next; 
FILE  *fp; 
char  'path; 

>; 


static  struct 


f  frame  *f  stack  =  NULL; 


void  push_f(FILE  *fp,  char  'path) 

( 

struct  f_f rame  'new  =  (struct  f_frame  *>  malloc ( sizeof ( struct  f_frame) ) 

new->next  =  f_stack; 
new->fp  -  fp; 
new->path  =  path; 


new; 
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struct  £_frane  *pop_f  ( vo id) 

struct  f_frame  *top  =  f_stack; 

rf  (top  /*  !  =  NULL  */>  ( 

f_stack  =  top->next; 
return  top; 
i  else  { 

fprintf  (stderr,  "FATAL:  pop_f  :  stack,  underf  lovAn" )  ; 
exit (-1) ; 


♦include  <sys/types . h> 

♦include  <sys/stat.h> 

♦  ae fine  MAXLNKLEN  128 

void  include (char  “name) 

char  ’spec  =  f spec ( inpath,  name); 

struct  stat  "so  =  (struct  stat  *)  malloc (rizeof (struct  stat)); 

char  lnkbv.f  [MAXLNKLEN]  ; 

int  lnklen; 

struct  f_frame  *top; 

push_f(infp,  inpath); 
inpath  =  path (spec); 
if  (lstat (spec,  sp)  ==  -1)  ( 

fprintf (stderr,  “FATAL:  include_line:  lstat  error:  %s\n",  spec); 
exit  (-1)  ; 

) 

wnile  ( (sp->st_mode  &  S_IFMT)  «=  S_IFLNK)  { 

if  ((lnklen  =  readlink  (spec,  lnkbuf,  MAXLNKLEN))  =»  -1)  { 

fprintf (stderr,  "FATAL:  include_2ine :  readlink  error:  is\n",  spec) ; 
exit  (-1)  ; 

} 

lnkbuf ( lnklen]  =  NULL; 
free (spec) ; 

spe ;  =  fspec (inpath,  lnkbuf); 
free ( inpath) ; 
inpath  =  path  (spec); 
if  (lstatfspec,  sp)  ==  -1)  { 

fprintf (stderr,  "FATAL:  include^line :  lstat  error:  %s\n",  spec); 
exit  (-1) ; 

) 

) 

free (sp) ; 

if  ((infp  =  fopen(spec,  "r"))  ==  NULL)  { 

fprintf (stderr,  "FATAL:  include_line :  fopen  error:  %s\n",  spec); 
exit  ( —  1 ) ; 

} 

free (spec) ; 
if  (yyparse  ()  ==  1)  ( 

fprint f (stderr,  "FATAL:  include_l ine :  yyparse  error\n") ; 
exit  (-1)  ; 

) 

fciose (infp) ; 
free ( inpath) ; 
top  =  pop_f  0 ; 
infp  -  top->fp; 
inpath  -  top->path; 
free (top) ; 

yychar  =  -1;  /*  force  a  call  to  yy  -x(l  */ 


Dell 
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♦define  TURN_ON  1 

♦define  LEAVE_ON  0 

♦define  TURN_OFF  -1 

typedef  struct  if_frame  ( 
struct  if_frarne  'next; 

int  upon_continue_if ;  /*  TURN_ON  or  LEAVE_ON  or  TURN_OFF  eliding  */ 

int  upon_wrapup_if ;  /'  YES  or  NO  -  eliding  turned  on  in  this  if  '/ 


static  struct  if_frame  'if_stack  =  NULL; 

void  push_if(int  f or_continue,  int  for_wrapup) 

struct  if_frame  'new  =  (struct  if_frame  ')  malloc (sizeof (struct  if_frame) ) 

new->next  =  if_stack; 

new->upon  continue_if  =  for_continue; 

new->upon_wrapup_if  =  for_wrapup; 

if_stack  =  new; 

) 

struct  if_frame  *pop_if (void) 

( 

struct  if_frame  'top  =  if_stack; 

if  (top  /*  !-  NULL  */)  { 
if_stack  =  top->next; 
return  top; 

)  else  { 

fprintf (stderr,  "FATAL:  pop_if:  stack  underf low\n”) ; 
exit  (-1)  ; 

) 

) 

void  setup_if(int  condition) 

{ 

if  (!eliding)  ( 

if  (condition) 

push_if (TURN_ON,  YES) ; 
else  ( 

eliding  =  YES; 
push_if (TURN_OFF,  NO) ; 

) 

)  else 

push_if (LEAVE_ON,  NO) ; 

) 

void  continue_if ( int  condition) 

( 

struct  if_frame  'top  =  pop_if(); 

switch  (top->upon_continue_if )  ( 

case  TURN_ON : 

eliding  =  YES; 
break; 

case  TURN_OFF: 

eliding  =  NO; 

/'  break;  */ 

) 

if  ( (eliding)  { 

if  (condition) 

pushif (TURN_ON,  YES) ; 
else  ( 

eliding  =  YES; 
push_if (TURN_OFF,  NO) ; 

) 

)  else 

push_if (LEAVE_ON,  top->upon_wrapup_if ) ; 

! 
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void  wraoup  if (void) 

<  • 

struct  if_frame  'top  =  pop_if(); 

switch  (top->upon_continue_if )  ( 

/*  case  TURNJON: 
eliding  =  YES; 
break;  */ 
case  TURN_OFF: 

eliding  =  NO;  4) 

/*  break;  */ 

) 

if  (top->upon_wrapup_if ) 
eliding  =  NO; 


char  'dequote (char  *s)  /*  remove 

( 

/ *  no  error  checking!  */ 
♦strrchr  (s,  )  =  NULL; 

return  ++s; 

} 


from  each  end  of  "'ed  string 


# include  " lex.yy.c" 
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/*  redefine  LEX  buffer  size  */ 
♦undef  YYLMAX 
♦define  YYLMAX  2048 

/*  cancel  LEX  defaults  */ 

♦  undef  input!) 

♦  undef  unput  (c) 

/*  prototypes  */ 
void  discard(int  n)  ; 
void  insert (char  *s); 

/*  variables  */ 
char  *exp; 


3N  (\\n)  + 

ID  [_A-Za-z] [_A-2a-zO-9] * 

WH  [  \t]+ 

%S  N  M  AO  A1 


<M>assign  return  ASSIGN; 

<M>clear  return  CLEAR; 

<M>define  return  DEFINE; 

<M>elif  return  ELIF; 

<M>else  return  ELSE; 

<M>elseif  return  ELSEIF ; 

<M>endif  return  ENDIF; 

<M>error  return  ERROR; 

<M>halt  return  HALT; 

<M>if  return  IF; 

<M>ifdef  return  IFDEF; 

<M>ifndef  return  IFNDEF; 

<M> include  return  INCLUDE; 

<M>message  return  MESSAGE; 

<M>option  return  OPTION; 

<M>set  return  SET; 

■:M>\${ID)\S  {  yytext  [yyleng-1]  =  '\0'; 

if  ( !normal_scan  II  '.expanding  II 

(exp  =  expand (yytext+1) )  ==  NULL)  ( 
yytext [yyleng-1]  =  'S'; 
yylval.s  =  yytext; 
return  GENERIC; 

)  else  {  f*  single  expansion  */ 
yylval.s  =  exp.- 
return  GENERIC; 


<M> { ID  > 


if  ( I normal_scan  II  lexpanding  II 

(exp  =  expand (yytext) !  ==  NULL)  ( 
yylval.s  =  strdup (yytext) ; 
return  IDENTIFIER; 

)  else  {  /*  expansion  */ 

discard (yyleng) ;  /*  rej 

insert (exp) ;  /*  wit 

yymore ( ) ; 


/*  replace  macro  */ 
/*  with  expansion  */ 
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pre . lex 


<M>\" l !  if  (yytext [yyleng-2 ]  ! =  '  \ \ ' )  (  /*  return  string  */ 

yylval.s  =  strdup (yytext) ; 
return  STRING; 

)  else  ( 

yyless (yyleng-1) ; 
yymore ( ) ; 

) 


<M>\- [1-9] [ 0- 9 ] * 
<M>  [1-9]  [  0-9]  * 


<M> \ - 0  [0-7] * 
<M>0 [0-7] * 


<M>\-0 [Xx] [0-9A-F] * 
<M>0 [Xx] [0-9A-F] * 


I 

(  sscanf (yytext ,  "%d",  Syylval.i); 

return  INTEGER; 
t 
I 

(  sscanf (yytext ,  "%o",  Syylval.i); 
return  INTEGER; 

) 

I 

{  sscanf (yytext,  "%x",  Syylval.i); 
return  INTEGER; 


<M> " 1 | " 
<M>SS 
<M>  ! 
<M>== 
<M> !  = 
<M>" <" 
<M>"  >'* 

<M>  ">  =  •' 
<M>" (” 
<M>  • ) " 


return  OR; 
return  AND; 
return  NOT; 
return  EQ; 
return  NE; 
return  LI; 
return  GT; 
return  LE; 
return  GE; 
return  '  ; 

return  ’ ) ’ ; 


<M,  A0>{WH) 


<A0> . 


(  discard (yyleng) ;  /*  skip  (<A0>  leading)  white-space  */ 

yy more  O; 

) 

{  yyless(O); 
yymore  0  ; 

BEGIN  Al; 

1 


<AlXWH)\n 
<A1> (WH } (BN) 


return  ' \n' ;  /*  skip  trailing  white-space  */ 

{  discard(2);  /*  skip  trailing  backslash-newline  */ 
yymo  re ( ) ; 

) 


<M, AO, Al> (BN )  {  discard (yyleng) ;  /*  skip  backslash-newlines  *V 

yymore ( ) ; 

} 

<M, AO , Al>" (  if  (yytext (yyleng -2]  ==  '*')  /*  skip  comments  */ 

discard (yyleng) ; 
else  (  /*  /*.../  */ 

discard (yyleng-2) ; 
yyless (0) ; 

) 

yymore  0 ; 

) 


<N, A1>\S ( ID) \S  (  yytext [yyleng-1]  *  '\0'; 

if  ( ! normal_scan  II  (expanding  I  I 

(exp  -  expand (yytext +1) )  -=  NULL)  ( 
yytext [yyleng-1]  =  'S'; 
yylval.s  =  yytext; 
return  GENERIC; 

)  else  (  /*  single  expansion  */ 

yylval.s  =  exp; 
return  GENERIC; 

) 

) 
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pre . lex 


<N,A1>(ID)  {  if  ( ! normal_scan  II  ! expanding  II 

(exp  =  expand (yytext ) )  ==  NULL)  ( 
yylval.s  =  yytext; 
return  GENERIC; 

}  else  (  /*  expansion  */ 

discard (yyleng) ;  /*  replace  macro  */ 

insert (exp) ;  /*  with  expansion  */ 

yymore ( ) ; 

} 


<N, Al>\" [ ""] *\"  (  if  (yytext [yyleng-2]  !  =  '\\')  (  /*  return  string  */ 

yylval.s  =  yytext; 
return  GENERIC; 

)  else  {  /*  "...V*  V 

yyless (yyleng-1) ; 
yymore ( ) ; 


) 


) 


\n 


return  MARK; 
return  ' \n' ; 


%% 


{  yylval.s  =  yytext; 
return  GENERIC; 


void  set_lex_start (int  start_condition) 

{ 

/*  Assign,  Mark,  and  Normal  are  #define'd  in  pre.c  */ 
switch  (start_condition)  ( 
case  Assign: 

BEGIN  AO; 
break; 
case  Mark: 

BEGIN  M; 
break; 

case  Normal: 

BEGIN  N; 


♦define  BUFSI2E  2048 


static  char  buf (BUFSIZE) , 
static  int  bufp  =  0; 


/*  managed  as  stack  */ 


static  int  nlf  =  0; 


char  input (void) 


/*  newline-flag  */ 

/*  get  next  character  for  LEX  *7 


( 


char  c; 


if  ( (c  =  (bufp  >  0)  ?  buf[ — bufp]  :  getc(infp))  ==  EOF) 
if  (nlf) 

return  NULL; 
else  ( 

buf[bufp++]  =  EOF; 
c  =  ' \n'  ; 


nlf  »  (c  ==  ' \n'  \ 
return  c; 
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pre . lex 


static  int  dis  =  0; 

void  discard(irtt  n) 

{ 

dis  =  n; 

yyless (yyleng-n) ; 


void  unput (char  c) 


/*  discard  last  n  characters  of  yytext  */ 


/*  unget  character  c  for  LEX  */ 


ii  (ais  >  0) 
dis  —  ; 
else  { 

if  (bufp  >=  BUFSIZE)  { 

fprintf  (stderr,  "FATAL:  unput:  buffer  overflowin''); 
exit  (-1 )  ; 

)  else  if  (c  /*  !=  NULL  */)  /*  never  unput  end-of-file  */ 

buf[bufp++]  =  c; 


void  insert (char  *s) 


char  *p  =  s; 


/*  insert  string  in  buf  */ 


while  (*p) 

p+  +  ; 

if  (bufp+(p-s)  >  BUFSIZE)  { 

fprintf  (stderr,  "FATAL:  insert:  buffer  overflowin’’); 
exit  (-1)  ; 

)  else 

while  (p  !«  s) 

buf(bufp++]  =  * — p; 


int  yywrap(void) 

( 

return  -1; 


/*  for  LEX  at  EOF  *! 
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Appendix  E  •  MAKE 


Makefile 
MAKE  .  C  .... 


Makefile 


MAKE:  MAKE . c 

gcc  -o  MAKE  MAKE.c 
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MAKE . C 


* 

♦ 


include 

include 


<stdio ,h> 
<st r ing . h> 


♦define  FALSE  0 
♦define  TRUE  1 


char  ’strdup (char  ’s)  /’  duplicate  string  */ 

char  ’p; 

p  =  (char  *)  mal  loc  ( strlen  ( s) +1)  ; 
if  (p  !=  NULL) 
strcpy  (p ,  s)  ; 
return  p; 


int  is_oref ix (char  ’prefix,  char  ’string) 

{ 

int  i  =  strlen  (prefix)  ; 

if  (i  <«  strlen (string)  &&  strncmp (string,  prefix,  i) 
return  1; 
else 

return  0; 


int  is_suf fix (char  ’suffix,  char  ’strino) 

{ 

int  i  =  strlen (string) -strlen (suffix) ; 

if  (i  >*  0  strcmp(string+i,  suffix)  -»  0) 
return  1; 
else 

return  0; 


0) 


♦include  <sys/types . h> 

♦include  <sys/dir.h> 

main(int  argc,  char  *argv(]) 

( 

char  *inf  «  NULL,  *outf  =  NULL,  ’optf  =  NULL; 

/*  input  file  name,  output  file  name,  option  list  file  name  */ 

char  *optv(128J  =  {  ".pre"  ); 

int  argi  =  0,  opti  «  0,  len; 
char  c; 

int  user_optf  =  FALSE;  /*  optf  user-specified  (via  -1)  */ 

DIR  ’dirfp; 

struct  direct  *dirp; 

FILE  ’optfp; 

char  opt [64];  /*  space  for  one  option  -  clumsy  but  effective  */ 
char  *pre,  ’def; 
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MAKE . c 


/  *  1st  scar,  through  arguments  -  process  -f  -o  -1  */ 
while  (--argi  <  argc) 
if  ( ’argv  (argi == 

switch  (c  =  * (argv f argi] +1) )  { 

case  ' V  : 

inf  =  strdup (argv [++argi] ) ; 
break; 
case  ’ o'  : 

outf  =  strdup  (argv  [  +  -t-argi  ])  ; 
break; 
case  ’ 1'  : 

optf  =  straup ^a-gv t , rargi ] ) ; 
user_optf  =  TRUE; 


if  (inf  ==  NULL)  /*  get  first  " . m "  fiie  in  current  directory  */  ( 
if  ( (dirfp  =  opendir ( " . " ) )  =-  NULL)  { 

fprintf (stderr,  “Fatal:  opendir  error:  current  directory  .Nn"); 
exit  (-1)  ; 

> 

do 

if  (  (dirp  =  readdir  (dirfp)  )  =*=  NULL)  { 

fprintf  (stderr,  "Fatal:  no  V.mV  file  in  current  directory\n" )  ; 
exit  (-1)  ; 

)  else  if  (is_suffix(" -m",  dirp->d_name) )  ( 

inf  =  strdup (dirp->d_name) ; 
break; 

) 

while  (TRUE); 
closedir (dirfp) ; 


if  ( opt  f  ==  NULL)  { 
len  =  str ie" (inf ) ; 
if  ( is_suf  f  ix  ("  .m“,  inf))  { 

optf  ”  (char  *)  malloc ( i+ (len-2) +7+1) ;  /*  for  . <inf~" .m"> .option\0  */ 
strcpy (optf ,  "."); 
strncat  (optf ,  inf,  len-2); 
st meat  (optf ,  ".option",  7); 

)  else  ( 

optf  =  (char  *)  malloc (l  +  len+7  +  l) ;  /*  for  . <in f >  . opt ion\0  */ 
strcpy  (optf,  "."); 
strncat (optf ,  inf,  len); 
strncat (opt f,  ".option",  7)  ; 


argi  *  0;  /*  reset  for  2nd  scan  */ 

/*  2nd  scan  through  arguments  -  process  rest  */ 
while  (++argi  <  argc) 

if  (*argv(argi]  ==  '-') 

switch  (c  =  *++argv (argi] )  ( 

case  ' f ' : 
case  ' o'  : 
case  '  1'  : 

++argi;  /*  skip  next  argument  (already  processed)  */ 
break; 
case  ' D'  : 

optv[++opti]  =  strdup ( "-D" ) ; 
if  (outf  =-  NULL) 

outf  =  st rdup ( "/dev/nul 1" ) ; 
break ; 
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MAKE. C 


rase 
optv 
if  lou 
if  ( 

ie 


opti]  =  scraup ("-L" ) ; 

tf  =-  NULL  II  strcmp(outf,  ” /dev/null” )  ==  0) 
user_optf)  /*  must  figure  out  option  list  file  name  »/  ( 

=  strlen  (inf)  ; 
if  (is_suf f ix (“ .m" ,  inf))  ( 

outf  =  (char  *)  malloc (1+ ( len-2) +7+1) ; 

/*  for  . < inf-" . m"> . option\0  */ 
strcpy (outf,  ” .") ; 
strncat (outf ,  inf,  len-2); 
strncat (outf ,  ".ODtion",  ?) ; 

}  else  ( 

outf  =  (char  *)  malloc ( l+len+?+l) ; 

/*  for  . <inf> . option\Q  */ 
strcpy  (optf, 

strncat  (optf,  inf,  len)  ; 
strncat  (optf,  ".option”,  7); 

}  else  /*  option  list  file  name  already  figured  out  -  copy  it  */ 
outf  =  strdup (optf ) ; 

} 

else  /*  get  first  option  (in  option  list  file) 

of  which  argument  is  a  valid  prefix  */  ( 
if  ((optfp  =  fopen(optf,  "r”)  )  ==  NULL)  ( 

fprintf (stderr,  "Fatal;  fopen  error:  option  list  file  %s\n”,  optf) 
exit  (-1)  ; 


) 


extract  prefix 


'/  ( 


def  =  strchr (argv[argij , 
if  (def  /*  ! -  NULL  */)  /* 
len  =  def-argv [argi ] ; 
pre  =  (char  *)  malloc ( len+1) ; 

*pre  =  ' \0' ; 

strncat  (pre,  argv[argi],  len)  ; 

)  else 

pre  =  argvfargij; 
do 

if  (fscanf (optfp,  "%s\n",  opt)  »«  EOF)  { 

fprintf (stderr,  "Fatal:  unknown  option:  %s\n”, 
exit (-1) ; 

else  if  ( is_pref ix (pre,  opt))  ( 

Lf  (def  /*  !=  NULL  */)  ( 
len  =  strlen (def ) ; 

optv[++opti]  =  (char  *)  malloc (2+strlen (opt) + len+1); 


pre)  ; 


) 


.\0 


/ 

"-a")  ; 
opt)  ; 

def,  len)  , 


/ *  for  -a<opt>= . . 
strcpy  (optv  (opt  i] 
strcat (optv [opti] 
strncat (optv (opti 
free (pre) ; 

)  else  ( 

len  *  strlen (opt); 
optv[++opti]  =  (char 
/*  for  -s<opt>\0  */ 
strcpy (optv(opti] ,  "-s"); 
st  meat  (optv  (cpti  ]  ,  opt,  len)  ; 


)  malloc (2+len+l); 


) 


) 

break; 

i 

while  (TRUE) ; 
fclose (optfp) ; 
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MAKE . c 


if  (outf  ==  NULL) 

outf  =  strdup  ("out  .pi")  ; 

/*  redirect  standard  input  */ 
if  (freopen < inf ,  "r",  stdin)  ==  NULL)  { 

fprintf (stderr,  "Fatal:  fopen  error:  input  file  %s\n",  inf); 
exit  (-1)  ; 


/*  redirect  standard  output  */ 

ir  ( freopen  'out f,  "w",  stdout)  ==  NULL)  f 

fprintf (stderr,  "Fatal:  fopen  error:  output  file  %s\n",  outf) ; 
exit  (-1)  ; 


opt v ( ++opt i ] 
execv ( " . pre" 


=  NULL;  /*  NULL-terminate  option  vector  */ 
optv) ; 
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driver 


#  /* 

(.bench)  driver 

Ralph  Haygood  based  on  code  by  Richard  O'Keefe  in  turn  based 
on  code  by  Paul  Wilk,  Fernando  Pereira,  David  Warren,  et  al. 

defines  driver/1  for  execution  time  measurement  (via  get_cpu_time/2) 
’/ 

#opt ion  BENCH  BIM_?L  C_P L  UUINTUS_PL  SB_PL  SICSTUS_PL  " 

>  Option  BENCH  includes  the  'bench'  for  execution 

>  time  measurement. 

> 

>  The  'bench'  uses  the  system-dependent  predicate 

>  get_cpu_time/2 .  If  one  of 

> 

>  BIM_?L  C_PL  QUINTUS_PL  SB_PL  SICSTUS_PL 

> 

>  is  selected,  then  an  appropriate  definition  for 

>  get_cpu  time/2  is  generated  automatically." 

%  driver (Name*Iterations) 

%  Call  benchmark/4  to  find  out  the  Action  and  its  Control,  perform 
%  the  specified  number  of  Iterations  of  them,  and  report  the  times. 

driver (Name*Iterations) 

integer (Iterations) , 

Iterations  >=  1, 

I 

benchmark (Name,  Action,  Control,  _) , 
get_cpu__time  (TO,  Unit), 

(  repeat (Iterations) ,  call (Action) ,  fail 
;  get_cpu_time (Tl,  Unit) 

)  , 

(  repeat ( Iterat ions) ,  call (Control) ,  fail 
;  get_cpu_time (T2,  Unit) 

)  , 

report (Name,  Iterations,  TO,  Tl,  T2,  Unit). 

%  driver(Name) 

%  Call  benchmark/4  to  find  out  how  many  Iterations  of  the  Action 
%  and  its  Control  to  perform,  perform  them,  and  report  the  times. 

driver  (Name) 

benchmark (Name,  Action,  Control,  Iterations), 
get_cpu_time (TO,  Unit), 

(  repeat (Iterations) ,  call (Action) ,  fail 
;  get_cpu_time (Tl,  Unit) 

)  , 

(  repeat (Iterations) ,  call (Control) ,  fail 
;  get_cpu_time (T2,  Unit) 

)  , 

report (Name,  Iterations,  TO,  Tl,  T2,  Unit). 


driver 


*if  BIM  PL 


% 

% 


get_cpu_time (T, 


seconds) 


get_cpu_time (T,  seconds)  : 
ftelseif  C_PL 

%  get_cpu_time (T,  seconds) 

% 


-  T  is  che  current  cpu  time 
(in  seconds  for  BIM  Prolog) . 

cput ime (T)  . 

-  T  is  the  current  cpu  time 
(in  seconds  for  C  Prolog). 


get_cpu_time (T,  seconds)  T  is 
(felseif  QUINTUS_PL 
%  get_cpu_time (T,  ' milli-seconds 
% 


cputime . 

')  T  is  the  current  cpu  time 

(in  milli-seconds  for  Quintus  Prolog) 


get_cpu_time (T,  'milli-seconds')  : 


#elseif  SB_PL 
%  get_cpu_time (T, 
% 


' milli-seconds'  ) 


statistics (runtime, [ T, _ ] ) . 

%  We  can't  use  the  second  element 
%  of  the  list,  as  some  tests  will 
%  call  statistics/2  and  reset  it. 

:-  T  is  the  current  cpu  time 

(in  milli-seconds  for  SB  Prolog) . 


get_cpu_t ime (T,  'milli-seconds')  :-  cputime(T). 

#elseif  SICSTUS_PL 

%  get_cpu_time (T,  'milli-seconds')  :-  T  is  the  current  cpu  time 
%  (in  milli-seconds  for  SICStus  Prolog) 

get_cpu_t ime ( T ,  'milli-seconds')  :-  statistics (runtime, [T,_] ) . 

%  We  can't  use  the  second  element 
%  of  the  list,  as  some  tests  will 
%  call  statistics/2  and  reset  it. 

#else 

#  message  "WARNING:  get_cpu_time/2  must  be  defined" 

(tendif 


%  report (Name,  N,  TO,  Tl,  T2,  Unit)  :- 

%  Take  the  number  of  iterations  and  the  three  times  yielded  by 

%  get_cpu_t ime/2  and  write  the  total,  overhead,  and  average. 


report (Name,  N,  TO,  Tl,  T2,  Unit)  :- 
TestTime  is  T1-T0, 

=(TestTime,  Unit,  TestTime_out,  Unit_out) , 
Overhead  is  T2-T1, 

= (Overhead,  Unit,  Overhead_out,  Unit_out) , 
Average_out  is  (TestTime_out-Overhead_out) /N, 
write (Name),  write  ('  took  '), 

write ( (TestTime_out-Overhead_out ) /N=Average_out ) , 
write  ('  '),  write (Unit_out) ,  write (' /iteration’ ) , 


nl . 


%  repeat (N)  :-  succeed  precisely  N  times. 

%  This  is  designed  solely  for  use  in  this  application;  for  a  general 
%  way  of  doing  this  use  the  standard  library  predicate  between/3,  or 
%  perhaps  repeat/0. 


repeat (N) 

-  N  >  0, 

from  (1, 

• 

from (I,  I) 

:  -  !  . 

from(L,  U) 

M  is 

(L+U)  >> 

from(L,  U) 

: -  M  is 

(L+U)  » 

N)  . 

1, 

1+1, 


fromiL,  M)  . 
from(M,  U)  . 
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driver 


%  =  (T1,  Unit  1 ,  T 2,  'Jnit2>  T1  Unitl  =  T2  Unit2. 

%  The  purpose  of  =/4  is  unit  conversion  -  the  intended  usage  is 
%  from  T1  Unitl  to  T2  Unit2.  In  particular,  the  purpose  is  time 

%  unit  conversion  for  report/6.  Preferentially,  times  convert  to 

%  miili-seconds .  However,  clauses  may  be  added  to  convert  to  any 
%  unit  desired. 


seconds,  T2,  'miili-seconds')  :- 
Unit,  T,  Unit)  .  %  "catch-all" 


! ,  T2  is  Tl'1000 . 
identity 


%  Trivial  predicates  for  use  as  controls. 

dummy . 

dummy (_) . 

dummy  (_,  _)  . 

dummy (_,  _,  _) . 

dummy  _)  . 

dummy  (_,  _,  ,  _,  _)  . 
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Appendix  G  •  Benchmark  Suite  Listing 


This  listing  of  the  benchmark  suite  is  broken  down  by  family. 

Page  numbering  is  independent  from  one  family  to  another  (each  family  starts  with  pag^ 
number  1). 

A  table  of  contents  precedes  the  listing  for  each  family. 

At  bottom  center  of  each  page  is  the  name  of  the  appropriate  family  followed  by  the  page 
number  within  the  family. 

At  top  center  of  each  page  is  the  name  of  the  file  appearing  on  the  page;  each  new  file  starts 
a  new  page. 

Files  appear  in  the  following  general  order;  master  files  (.m  extension);  files  shared  by 
more  than  one  master  file  via  include  directives  (no  extension);  input  data  files  (where 
required);  bench  interface  files  (.bench. name);  files  associated  with  code  in  a  language 
other  than  Prolog  (Lisp  files  for  gabriel  and  C  files  for  tp). 


asp 


inverter .m . 

random_logic .m  . 

compactor  . 

inverter .sip  . 

random_logic . sip  . 

sml .m . 

viper . 

sml  . 

. inverter .bench  . 

. random_logic .bench 
. sml .bench  . 


1 

2 

3 

29 

30 

34 

35 

55 

56 

57 

58 


inverter .m 


*  /  * 

inverter. m:  benchmark  (compactor)  inverter  master  file 

"/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s):  S _ OPTIONS _ S 

% 

%  (compactor)  inverter 

% 

%  The  ASP  Group 

% 

%  (contact:  Bill  Bush 

%  Computer  Science  Division 

%  University  of  California 

%  Berkeley,  CA  94720 

%  bush3ophiuchus.3erkeley.EDU) 

% 

%  compact  inverter  cell 
#if  BENCH 

#  include  " . inverter -bench" 

#else 

inverter  consult (' examples/ in/inverter . sip' ) , 
compact ( ' examples/out/inverter' ) . 

((option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

#  if  SHOW 

show . 

#  endif 
#endif 

((option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (compact/1). 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.” 

#if  DUMMY 

compact (_) . 

((else 

ft  include  "compactor"  /*  code  for  compactor  '/ 

#  message  "NOTE:  The  compactor  does  not  clean  up  the  database  when  it  is  finished 

#  message  "  so  this  benchmark  should  not  be  run  several  times  in  succession 

#  message  "  the  Prolog  system  should  be  stopped  and  restarted  after  each  run 

((endif 
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♦  /* 

random_logic .m:  benchmark  (compactor)  random_iogic  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s):  $ _ OPTIONS _ $ 

% 

%  (compactor)  random_logic 

% 

%  The  ASP  Group 

% 

%  (contact:  Bill  Bush 
%  Computer  Science  Division 

%  University  of  California 

%  Berkeley,  CA  94T20 

%  bush@ophiuchus.3erkeley.EDU) 

% 

%  compact  random  logic  cell  (for  a  chess  chip) 

♦  if  BENCH 

♦  include  ". random_logic .bench" 

#else 

random_logic  consult (' examples/in/ random_logic . sip' ) , 
compact (' examples/out/randora_logic' ) . 

♦option  SHOW  “ 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

♦  if  SHOW 

show. 

♦  endif 
♦endif 

♦option  DUMMY  » 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (compact/1). 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 

♦if  DUMMY 

compact (_) . 

♦else 

♦  include  "compactor"  /*  code  for  compactor  */ 

♦  message  "NOTE:  The  compactor  does  not  clean  up  the  database  when  it  is  finished," 

♦  message  "  so  this  benchmark  should  not  be  run  several  times  in  succession 

♦  message  "  the  Prolog  system  should  be  stopped  and  restarted  after  each  run." 

♦endif 
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#  /* 

compactor:  code  for  ASP  compactor  component 
*/ 

%  (c)  1988  Regents  of  the  University  of  California 

% 

%  This  is  a  version  of  the  cell  compactor  developed  at  the  University 
%  of  California,  Berkeley,  as  an  element  of  the  ASP  (Advanced  Silicon 

%  compiler  in  Prolog)  system.  The  compactor  is  a  CAD  tool  for  VLSI 

%  design.  It  uses  a  four-pass  deterministic  algorithm  to  transform 
%  an  input  cell  into  an  output  cell  of  near-minimum  silicon  area.  The 
%  input  language  is  Sticks,  a  virtual  device  specification  language, 

%  and  the  main  output  language  is  CIF,  a  physical  layout  description 
%  language.  The  compactor  transforms  a  virtual  device  (grid)  repre- 
%  sentation  into  a  physical  layout  representation  using  fabrication 
%  design  rules. 

% 

%  From  a  Sticks  specification  in  file  name  (assumed  already  loaded), 

%  the  compactor  generates  four  output  files: 

% 

%  name.bbox 

%  name.bdr 

%  name.cif 

%  name. space 

% 

%  When  show/0  is  provable,  the  compactor  produces  output  (intended 

%  for  a  terminal  screen)  indicating  the  number  of  the  virtual  row 

%  or  column  it  is  currently  processing  (row  on  the  first  and  second 
%  passes  and  column  on  the  third  and  fourth  passes)  . 

» 

%  The  compactor  uses  two  predicates,  floor/2  and  sqrt/2,  which  are 
%  evaluated  differently  under  different  Prolog  systems.  These  must 
%  be  defined  for  any  Prolog  system  under  which  the  compactor  is  run. 

% 

%  The  compactor  does  not  clean  up  the  database  when  it  is  finished, 

%  so  it  should  not  be  run  several  times  in  succession.  The  Prolog 
%  system  should  be  stopped  and  restarted  after  each  run. 


ftoption  " 

>  For  use  with  Quintus  Prolog,  compactor  requires 

>  some  Quintus  P rolog-specif ic  directives.  These 

>  are  generated  if  option  QUINT'JS_PL  is  selected. 
*if  QUINT'JS_PL 

:-  no_style_check (single_var) . 

:-  unknown (_,  fail). 


#endif 

compact (Name)  :- 
brktrans, 
crap, 
genbox, 
balance, 
expand (Name) , 
writef ile (Name) , 


brktrans 

trans  (Type,  pt  (Sx,  Sy)  ,pt  (Gx,  Gy)  ,  pt  (Dx,  Dy)  ,  W,  L,  Sn,  Gn,  Dn)  , 
genconstl (Type,  Sx,  Sy,  Dx,  Dy,  W,  L,  Sn,  Gn,  Dn) , 
genconst  (Type,  Sx,  Sy,  Gx,  Gy,  Dx,  Dy,  W,  L,  Sn,  Gn,  Dn)  , 
fail, 
brktrans . 

genconstl (Type,  Sx,  Sy,  Dx,  Dy,  W,  L,  Sn,  Gn,  Dn)  :- 
Wovl  is  W/L, 

larger(l,  Wovl,  Dntcr,  Wlrat), 
transtype  (Type,  Layer), 

assert  (wire  (Layer,  pt  (Sx,  Sy)  ,  pt(Dx,  Dy)  ,  Wlrat,  tnods(Sn,  Gn,  Dn)  )  )  , 
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transtype (pd,  pdtrans) . 
transtype  (nd,  ndtrans)  . 

genconst  (Type,  Sx,  Sy,  Gx,  Gy,  Ox,  Oy,  W, 
Sx  =  Gx, 
width (p,  Pwid) , 

Lw  is  L/W, 

larger(Lw,  1,  S,  Larg) , 

Sspace  is  Larg*Pwid, 

assert (gethpic (Gy, Gx, Gn,  Sspace)),  !. 
genconst  (Type,  Sx,  Sy,  Gx,  Gy,  Dx,  Dy,  W, 
Sy  =  Gy, 
width  (p,  Pwid)  , 

Lw  is  L/W, 

larger(Lw,  i,  S,  Larg), 

Sspace  is  Larg’Pwid, 

assert  (get  vpic  (Gx,  Gy,  Gn,  Sspace)),  :. 


On)  :  - 


cmp  :  - 

xcompact, 
ydtoxd, 
ycompact, 
trueydist(0,  0), 
truexdist  (0,  0)  , 

ordconst,  9 

makediag, 

doubled,  ! . 


%  compaction  for  x  dimension, 
xcompact  :- 
rmconst, 

initmap,  9 

maxrow (Rowl) , 
initconst (Rowl) , 

(show  ->  write ('beginning  pass  1...'),  nl  ;  true), 

(show  ->  wr ite (' cur rent  row:'),  nl  ;  true), 
xcoordex(O),  !, 
rmmap (right) , 
initmap, 

(show  ->  write (' beginning  pass  2...'),  nl  ;  true),  9 

(show  ->  write  (' current  row:'),  nl  ;  true), 
xcoordexb (Rowl) , 
rmmap (left) ,  ! . 

%  remove  any  existing  dist  values, 
rmconst  :- 

ret ract  (ydist  (_,_,_))  ,  _ 

fail.  9 

rmconst  :- 

retract  (xdist  (_,_,_)  )  , 
fail, 
rmconst . 

%  initialize  elists. 
initmap  :- 

assert (elist  (p,  [])),  9 

assert (elist  (di f ,  (])), 

assert (elist (ml,  [])), 
assert (elist (m2,  [])). 

%  3et  all  ydist  values  to  zero, 
initconst (0) . 
initconst (Rowl)  :- 

Lastrow  is  Rowl  -  1,  9 

assert (ydist (Lastrow,  Rowl,  0)), 
initconst (Lastrow)  ,  !. 
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rmmap(Side) 

retract (eiist (Layer,  Elements) ) , 
assert (border (Side,  Layer,  Elements)), 
fail, 
rmmap (_) . 

%  compact  in  the  x  dimension,  0->maxrow. 
xcoordex (Row) 
maxrow (Rowl ) , 

Rowl  <  Row,  ! . 
xcoordex (Row) 
getrow (Row) , 

(show  ->  write (Row),  nl  ;  true), 

Nextrow  is  Row  +  1, 
xcoordex  (Nextrow)  ,  !. 

%  compact  in  the  x  dimension,  maxrow->0. 
xcoordexb (Row) 

Row  <0,  . 

xcoordexb (Row) 
getrow (Row) , 

(show  ->  write (Row),  nl  ;  true), 

Nextrow  is  Row  -  1,  !, 

xcoordexb  (Nextrow)  ,  !. 

%  get  all  contacts  in  a  row. 
getrow (Row) 

getcel (Row,  Type,  Y,  Node), 
contlayer (Type,  Layerl,  Layer2) , 
appendel (Row,  Layerl,  Y,  Y,  1,  Node,  Type), 
appendel (Row,  Layer2,  Y,  Y,  1,  Node,  Type), 
fail,  !. 

%  get  all  wires  in  a  row. 
getrow  (Row) 

getwel (Row,  Layer,  Yl,  Y2,  Wid,  Node), 
larger (Yl,  Y2,  S,  L) , 

appendel (Row,  Layer,  S,  L,  Wid,  Node,  Layer), 
fail,  i  . 

%  get  all  transistor  pickets  in  a  row. 
get  row  (Row) 

get ’/pic  (Row,  Y,  Nocie,  Wiatm, 
lretract (pd,  Eiist), 

addeltomap (Row,  tspot,  Y,  Y,  Width,  Node,  Eiist,  Elistout), 
lassert(pd,  Elistout), 
fail,  !. 
getrow  (Row)  . 

%  add  poly  or  diffusion  to  eiist. 

%  they  must  check  more  than  1  eiist.... 
appendel (Row,  Layer,  S,  L,  Wid,  Node,  Type) 
test  (Layer)  , 
lretract (Layer,  Eiist), 

addeltomap (Row,  Type,  S,  L,  Wid,  Node,  Eiist,  Elistout),  !, 
lassert  (Layer,  Elistout), 
dual (Layer,  Duolayer) , 
lbind (Duolayer,  Duoelist)  , 

addeltomap (Row,  Type,  S,  L,  Wid,  Node,  Duoelist,  Dontcare) ,  !. 

%  add  m2  or  ml  to  eiist. 

appendel (Row,  Layer,  S,  L,  Wid,  Node,  Type) 
lretract (Layer,  Eiist), 

addeltomap (Row,  Type,  S,  L,  Wid,  Node,  Eiist,  Elistout), 
lassert  (Layer,  Elistout),  !. 

addeltomap (Row,  Layer,  S,  L,  Wid,  Node,  Eiist,  Elistout) 

searchlist (Row,  Layer,  S,  L,  Wid,  Node,  Eiist,  Glist,  Llist,  Withinlist,  x) , 
diagaddfRow,  Layer,  S,  L,  Wid,  Node,  Glist,  Llist, Withinlist,  Elistout),  !. 
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%  add  diagonal  constraints  if  necessary. 

diagadd(Row,  Layer,  S,  L,  Wid,  Node,  Glist,  Llist,  Withinlist,  Elistout) 
rev(Llist,  Newllist), 

adducons (Row,  Layer,  S,  L,  Hid,  Node.  Glist), 
addlcons (Row,  Layer,  S,  L,  Hid,  Node,  Newllist), 
listio (Layer,  S,  L,  Hid,  Node,  Row,  Elementpac) , 
append ( (Elementpac] ,  Hithinlist,  NewWithin), 
append (NewHithin,  Glist,  Newglist) , 
append (Ll 1st ,  Newglist,  Elistout),  !. 


%  add  upper  constraint, 
adducons (Row,  Layer,  S, 

L, 

Hid, 

Node, 

adducons  (Row,  Layer, 

s. 

L, 

Wid, 

Node, 

Layer  =  tspot,  ! . 
adducons (Row,  Layer, 

s. 

L, 

Hid, 

Node, 

listio (Layerf,  Yl 

,  Y2, 

Widf, 

Nodef 

Row  =  Rowf ,  !  . 

adducons (Row,  Layer,  S,  L,  Hid,  Node,  (Element ! Glist ] ) 
listio  (Layerf,  Yl,  Y2,  Widf,  Nodef,  Rowf,  Element), 

Nodef  =  Node, 

Nodef  =\=  -1,  !  . 

adducons (Row,  Layer,  S,  L,  Hid,  Node,  [Element iGlist] ) 
listio (Layerf ,  Yl,  Y2,  Hidf,  Nodef,  Rowf,  Element), 

Layerf  =  tspot, 

adducons (Row,  Layer,  S,  L,  Hid,  Node,  Glist),  !. 

adducons (Row,  Layer,  S,  L,  Hid,  Node,  (Element IGlist] ) 
listio  (Layerf,  Yl,  Y2,  Hidf,  Nodef,  Rowf,  Element), 
f indcontact (Row,  Yl,  Hidf,  Layerf,  Cwid,  Clayer) , 
addconst (L,  Yl,  Layer,  Hid,  Row,  Layerf,  Hidf,  Rowf),  !. 

f indcontact (X,  Y,  Widf,  Layerf,  Cwid,  Clayer) 
cont(Type,  pt (X,  Y) ,  Oset,  Node), 
width (Type,  Conw) , 
width (Layerf ,  Fwid) , 

Nfw  is  Fwid  *  Widf, 

(Nfw  >  Cnnw-' 

Clayer  =  Layerf, 

Cwid  =  Widf; 

Clayer  =  Type, 

Cwid  = :=  1) ,  ! . 

f indcontact (X,  Y,  Widf,  Layerf,  Widf,  Layerf)  !. 

addconst (S,  L,  Layers,  Hids,  Rows,  Layerl,  Hidl,  Rowl) 

tyconst  (S,  L,  Layers,  Wids,  Rows,  Layerl,  Hidl,  Rowl); 
tyconst  (S,  L,  Layerl,  Hidl,  Rows,  Layers,  Wids,  Rowl),  !. 

addconst (S,  L,  Layers,  Wids,  Rows,  Layerl,  Widl,  Rowl) 
larger  (Rows,  Rowl,  Sr,  Lr)  , 

assert  (tyconst  (S,  L,  Layers,  Wids,  Sr,  Layerl,  Widl,  Lr)  )  , 


%  add  lower  constraint, 
addlcons (Row,  Layer,  S, 
addlcons (Row,  Layer,  S, 
Layer  =  tspot,  ! . 
addlcons (Row,  Layer,  S, 
listio  (Layerf,  Yl,  Y2 
Row  =  Rowf,  ! . 
addlcons (Row,  Layer,  S, 
listio  (Layerf,  Yl,  Y2 
Nodef  =  Node,  ! . 
addlcons (Row,  Layer,  S, 
listio (Layerf,  Yl,  Y2 
Layerf  =  tspot, 
addlcons  (Row,  Layer, 
addlcons (Row,  Layer,  S, 
listio  (Layerf,  Yl,  Y2 
f indcontact (Row,  Y2, 
addconst (Y2,  S,  Layer 


L,  Wid,  Node,  ( ] )  . 

L,  Wid,  Node,  List) 

L,  Hid,  Node,  (Element  I Llist ] ) 

,  Hidf,  Nodef,  Rowf,  Element), 

L,  Hid,  Node,  (Element  I Ll ist ] ) 

,  Hidf,  Nodef,  Rowf,  Element), 

L,  Wid,  Node,  (Element  I Llist] ) 

,  Widf,  Nodef,  Rowf,  Element), 

S,  L,  Wid,  Node,  Llist),  !. 

L,  Wid,  Node,  (Element  I Ll ist ] ) 

,  Widf,  Nodef,  Rowf,  Element), 
Widf,  Layerf,  Cwid,  Clayer)  , 
f,  Widf,  Rowf,  Layer,  Hid,  Row)  ,  ! 
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test (p)  . 
test  (pd)  . 
test (pdtrans)  . 
test (nd)  . 
test (ndtrans)  . 

rep  (ml,  ml)  . 
rep (m2 ,  m2 ) . 
rep (pd,  dif )  . 
rep (nd,  dif)  . 
rep  (pdtrans,  dif). 
rep (pdtrans,  p)  . 
repfndtrans,  dif)  . 
rep  (ndtrans,  p)  . 
rep (p,  p)  . 

%  can  be  pd  or  nd,  choose  nd. 
dual (p,  nd)  . 
dual (nd,  p) . 
dual (pd,  p) . 

%  get  elist. 

Iretract (Layer,  List)  :- 
rep (Layer,  Rep), 
retract (elist (Rep,  List)),  !. 

%  get  elist  without  retracting 
lbind (Layer, List) 
rep (Layer,  Rep), 
elist (Rep,  List) ,  !  . 

%  put  elist. 
lassert (Layer,  List) 
rep (Layer,  Rep), 
assert (elist (Rep,  List)),  ! . 

%  get  contacts  . 
getceKRow,  Type,  Y,  Node) 

cont (Type,  pt (Row,  Y) ,  Oset,  Node). 

%  get  wires. 

getwel (Row,  Layer,  Yl,  Y2,  Wid,  Node) 

wire (Layer,  pt (Row,  Yl) ,  pt (Row,  Y2) ,  Wid,  Node) 
( var (Wid) -> 

Wid  =  1; 
true) . 


%  convert  ydist  values  to  xdist  values  (change  name) 
ydtoxd  :- 

retract (ydist (Rl,  R2,  D) ) , 
assert (xdist (Rl,  R2,  D) ) , 
ydtoxd,  ! . 
ydtoxd . 


%  compaction  for  y  dimension, 
ycompact 

maxcol  (Col  1)  , 
initmap, 

inityconst (Coll)  , 

(show  ->  write (' beginning  pass  3...'),  nl  ;  true) 
(show  ->  wr ite (' current  column:'),  nl  ;  true), 
ycoordey (0) ,  ! , 

rmmap (top) , 
initmap, 

(show  ->  write (' beginning  pass  4...'),  nl  ;  true) 
(show  ->  write (' current  column:'),  nl  ;  true), 
ycoordeyb (Coll ) , 
rmmap (bottom) ,  !. 
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inityconst  (0)  . 
inityconst (Coll) 

Lastcol  is  Coll  -  1, 
ydist  (Lastcol,  Coll,  0), 
initconst (Lastcol) ,  !. 

inityconst (Coll) 

Lastcol  is  Coll  -  1, 

assert (ydist (Lastcol,  Coll,  0)), 

initconst (Lastcol) ,  t. 

ycoordey (Col) 
maxcoi (Coil) , 

Coll  <  Col,  !  . 
ycoordey  (Col) 
getcol  (Col ) , 

(show  ->  write (Col),  nl  ;  tree), 

Nextcol  is  Col  +  1,  !, 

ycoordey (Nextcol) ,  !. 

ycoordeyb (Col) 

Col  <0,  !  . 
ycoordeyb  (Col) 
getcol (Col) , 

(show  ->  write (Col),  nl  ;  true), 

Nextcol  is  Col  -  1, 
ycoordeyb (Nextcol) ,  ( . 

getcol  (Col) 

getcyel(Col,  Type,  Y,  Node), 
contlayer (Type,  Layerl,  Layer2) , 
yappendel (Col,  Layerl,  Y,  Y,  1,  Node,  Type), 
yappendel (Col,  Layer2,  Y,  Y,  1,  Node,  Type), 
fail,  !  . 
getcol  (Col) 

getwyel(Col,  Layer,  XI,  X2,  Wid,  Node), 
larger (XI,  X2,  S,  L) , 

vappendel (Col,  Layer,  S,  L,  Wid,  Node,  Layer), 
tail,  !  . 
getcol  (Col) 

gethpic(Col,  X,  Node,  Width), 

Iretract (pd,  Eiist) , 

addyeltomap  (Col,  tspot,  X,  X,  Width,  Node,  Eiist,  Eiistout), 
lassert (pd,  Eiistout), 
fail,  !. 
getcol  (Col)  . 

yappendel (Col,  Layer,  S,  L,  Wid,  Node,  Type) 
test  (Layer)  , 

Iretract (Layer,  Eiist), 

addyeltomap  (Col,  Type,  S,  L,  Wid,  Node,  Eiist,  Eiistout),  , 
lassert  (Layer,  Eiistout), 
dual (Layer,  Duolayer) , 

Iretract (Duolayer,  Duoelist) , 

addyeltomap (Col,  Type,  S,  L,  Wid,  Node,  Duoelist,  Dontcare) , 
lassert (Duolayer,  Duoelist),  !. 
yappendel (Col,  Layer,  S,  L,  Wid,  Node,  Type) 

Iretract (Layer,  Eiist), 

addyeltomap (Col,  Type,  S,  L,  Wid,  Node,  Eiist,  Eiistout), 
lassert  (Layer,  Eiistout)  ,  !  . 

addyeltomap (Col,  Layer,  S,  L,  Wid,  Node,  Eiist,  Eiistout)  : - 

searchlist (Col,  Layer,  S,  L,  Wid,  Node,  Eiist,  Glist,  Llist,  Withinlist,  y) , 
yeladdICol,  Layer,  S,  L,  Wid,  Node,  Glist,  Llist,  Withinlist,  Eiistout),  !. 

yeladdICol,  Layer,  S,  L,  Wid,  Node,  Glist,  Llist,  Withinlist,  Eiistout) 
listio (Layer,  S,  L,  Wid,  Node,  Coi,  Eiementpac) , 
append ( [Eiementpac] ,  Withinlist,  NewWithin), 
append (NewWithin,  Glist,  Newglist), 
append  (Llist,  Newglist,  Eiistout),  . 
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geccyel  (Col,  Type,  X,  Node)  :  - 

contlType,  pt(X,  Col),  Oset,  Node) . 

gecwyel(Col,  Layer,  XI,  X2,  Wid,  Node) 

wire(Layer,  pc (XI,  Col),  pc (X2,  Col),  Wid,  Node), 

( var (Wid) -> 

Wid  =  1; 
crue)  . 

searchlist (Row,  Layer,  S,  L,  Wid,  Node,  [],  (],  [],  [],  DirecCion)  . 

searc’nlisC  (Row,  Layer,  S,  L,  Wid,  Node,  [),  _,  _,  _,  DirecCion). 

searchlisC (Row,  Layer,  S,  L,  Wid,  Node,  (Eleml Eliscin] ,  [Elem I Glist ] ,  Llisc, 

Wichinlist,  DirecCion  ) 

liscio (Layerf ,  Yl,  Y2,  Widf,  Nodef,  Rowf,  Elem), 

Y1  >  L,  !  , 

searchlisC (Row,  Layer,  S,  L,  Wid,  Node,  Eliscin,  Glisc,  LlisC, 

Withiniisc,  DirecCion),  !. 

searchlisC (Row,  Layer,  S,  L,  Wid,  Node,  [Elem i Elisc in j ,  Glist,  (Elem I  LI isc ] , 

WiChinlisC,  DirecCion) 

lisCio  (Layerf ,  Yl,  Y2,  Widf,  Nodef,  Rowf,  Elem), 

S  >  Y2,  !, 

searchlisC (Row,  Layer,  S,  L,  Wid,  Node,  Eliscin,  GlisC,  Llisc, 

WiChinlisC,  DirecCion) ,  ! . 

searchlisC (Row,  Layer,  S,  L,  Wid,  Node,  [Eleml Eliscin] ,  Glisc,  Llisc, 
[ElemlWithinlist] ,  DirecCion) 
listio  (Layerf,  Yl,  Y2,  Widf,  Nodef,  Rowf,  Elem), 

Row  =  Rowf,  ! , 

searchlisC (Row,  Layer,  S,  L,  Wid,  Node,  Elistin,  GlisC,  LlisC,  Withiniisc 
Direction) ,  !  . 

searchlist (Row,  Layer,  S,  L,  Wid,  Node,  (Eleml El ist in ] ,  Glist,  Llist, 
Withinlist,  Direction) 

listio (Layerf,  Yl,  Y2,  Widf,  Nodef,  Rowf,  Elem),  !, 
checonst (Layerf,  Widf,  Nodef,  Rowf,  Layer,  Wid,  Node,  Row),  !, 
searchl ist  (Row,  Layer,  S,  L,  Wid,  Node,  Elistin,  Glis*-,  Llist,  Withinlist 
Direction),  !. 

listio  (Layer,  S,  L,  Wid,  Node,  Grid,  Element) 

Element  =  [Layer,  S,  L,  Wid,  Node,  Grid],  !. 

checonst (Layerf ,  Widf,  Nodef,  Rowf,  Layer,  Wid,  Node,  Row)  : - 
contacts  (I.ayerf,  Layer), 
larger  (Row,  Rowf,  Rows,  Rowl), 
f indrdist (Rows,  Rowl,  0,  Dist),  !, 
mindist  (Layer,  Wid,  Layerf,  Widf,  Mindist),  , 
direction (Row,  Rowf,  Lastrow) ,  !, 

compdist (Dist,  Mindist,  Row,  Lastrow),  ! . 


checonst (Layerf, 
Nodef  =  Node, 
Nodef  =\=  -1, 

Widf, 

Nodef, 

Rowf, 

Layer, 

Wid, 

Node, 

Row) 

checonst (Layerf, 

Widf, 

Nodef, 

Rowf, 

Layer, 

Wid, 

Node, 

Row) 

larger  (Row,  Rowf,  Rows,  Rowl), 
f indrdist (Rows ,  Rowl,  0,  Dist),  !, 
mindist  (Layer,  Wid,  Layerf,  Widf,  Mindist),  !, 
direction (Row,  Rowf,  Lastrow),  !, 
compdist (Dist,  Mindist,  Row,  Lastrow),  (. 

contacts (Layerl,  Layer2) 
contlayer (Layerl,  _,  _) , 
contlayer (Layer2 ,  _,  _) ,  !. 

f indrdist (Colg,  Colg,  Idist,  Idist)  . 

findrdist (Coll,  Colg,  Idist,  Dist) 

Nextco  1  is  Coll  +  1,  (, 

ydisttColl,  Nextcol,  Distbet), 

Newidist  is  Idist  *  Distbet, 

findrdist (Nextcol,  Colg,  Newidist,  Dist),  !. 
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ispace  is  spacing  distance  in  units.... 

%Wspace  is  half  of  the  minimum  widtn  space  for  the  -aver. 

mind  1st (Layer,  Wid,  Layerf,  Widf,  Dbetob)  : - 
space (Layer,  Layerf,  List), 
width (Layer,  Wspace), 

Widmod  is  (Wid  *  Wspace) , 
width (Layerf ,  Wspacef ) , 

Widfmod  is  (Widf  *  Wspacef), 

□  betob  is  List  +  Widmod  *  Widfrrca. 

direct  ion (Row,  Crow,  Lrow) 

Crow  <  Row, 

Lrow  is  Row  -  1,  !  . 

direct  ion (Row,  Crow,  Lrow) 

Lrow  is  Row  +  1 ,  ! . 

compaist (D 1st ,  Dbetob,  Row,  Lastrow)  : - 
Dist  >=  Dbetob,  ! . 

compdist (Dist,  Dbetob,  Row,  Lastrow) 
larger (Row,  Lastrow,  Srow,  Grow), 
retract (ydist (Srow,  Grow,  Distbet)), 

Difdist  is  Dbetob  -  Dist, 

Newdist  is  Difdist  +  Distbet, 

assert (ydist (Srow,  Grow,  Newdist)),  !. 


trueydist (Col,  Dist) 
maxcoi (Maxcoi) , 

Col  >=  Maxcoi, 
assert (ncol (0,  0)),  !. 

trueydist (Col ,  Dist) 

Nextcol  is  Col  +  1, 
ydist  (Col,  Nextcol,  Ddist)  , 
Newdist  is  Dist  +  Ddist, 
assert (hcol (Nextcol,  Newdist)), 
trueydist (Nextcol,  Newdist),  !. 


t ruexdist (Row,  Dist) 
maxrow (Maxrow) , 

Row  >=  Maxrow, 
assert (hrow (0,  0) ) ,  !  . 

t ruexdist (Row,  Dist) 

Nextrow  is  Row  +  1, 
xdist (Row,  Nextrow,  Ddist), 
Newdist  is  Dist  +  Ddist, 
assert (hrow (Nextrow,  Newdist)), 
truexdist (Nextrow,  Newdist),  I. 


ordconst 

getconst (S,  L,  Layers,  Wids,  Rows,  Layeri,  Midi,  Row!) , 
makehard(S,  L,  Layers,  Wids,  Rows,  Layeri,  Widl,  Bowl), 
fail,  !  . 
ordconst . 

getconst (S,  L.  Layers,  Wids,  Rows,  Layeri,  Widl,  Rowi) 

retract (tyconst (S,  L,  Layers,  Wids,  Rows,  Layeri,  Widl,  Rowl)). 

%  remove  redundant  diagonal  constraints  and 
%  determine  direction  of  diagonal  stretch. 
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makehardlS,  L,  Layers,  Wids,  Rows,  Layer!,  Midi,  Rowl)  : - 
f inaistx (Rows,  Rowl,  Xdist), 
fi.ndistyfS,  L,  Ydist), 

mindiagdist (Xdist,  Ydist,  Layers,  Wids,  Layerl,  Widl,  Dbetob) , 

Difdist  is  (Dbetob  *  Dbetob), 

Xdistsq  is  (Xdist  *  Xdist) , 

Ydistsq  is  (Ydist  *  Ydist), 

Alreadist  is  Xdistsq  +  Ydistsq, 

(Alreadist  <  Difdist-> 

(Xdistsq  >=  Ydistsq  -> 

assert  (rcon  (Rows,  Rowl,  S,  L,  Wids,  Widl,  Layers,  Layerl,  Difdist)); 
assert  (ccon  (S,  L,  Rows,  Rowl,  Wids,  Widl,  Layers,  Layerl,  Difdist))) 
t  rue)  ,  . 

makenard(S,  L,  Layers,  Wids,  Rows,  Layer!,  Widl,  Rowl). 

f indistx (Rowl,  Rowg,  Dist) 
hrowfRowg,  Rowgv) , 
hrow(Rowl,  Rowlv) , 

Dist  is  Rowgv  -  Rowlv,  ! . 

findisty (Coll,  Colg,  Dist) 
hcol(Colg,  Colgv) , 
hcolfColl,  Collv), 

Dist  is  Colgv  -  Collv,  ! . 


%  generate  and  sort  the  list  of  diagonal  constraints 
makediag 

assembler (Xcon) , 
quisort (Xcon,  Newxcon), 
assembler (Ycon) , 
quisort (Ycon,  Newycon), 
settlercon (Newxcon) , 
settleccon (Newycon) ,  !. 

%  put  diagonal  constraints  into  a  list 
assembler ( [Rc I  List ] ) 

retract (rcon (Rows,  Rowl,  S,  L,  Wids,  Widl,  Layers,  Layerl,  Difdist)), 
Rc  =  con (Rows,  Rowl,  S,  L,  Wids,  Widl,  Layers,  Layerl,  Difdist), 
assembler (List) ,  !. 

assembler  (  []  )  . 

assembiec ( [Rc , List] ) 

retract  (ccon  (S,  L,  Rows,  Rowl,  Wids,  Widl,  Layers,  Layerl,  Difdist)), 
Rc  =,  con(S,  L,  Rows,  Rowl,  Wids,  Widl,  Layers,  Layerl,  Difdist), 
assembler (List ) ,  !. 

assembiec  (  []  )  . 

%  Resolve  diaco:.al  constraints 

settlercon ( [ J ) . 
settlercon  (([])). 
sett lercon ( [Elem I  List ) ) 

Elem  =  con (Rows,  Rowl,  S,  L,  Wids,  Widl,  Layers,  Layerl,  Difdist), 
findistx (Rows,  Rowl,  Xdist), 
findisty(S,  L,  Ydist), 

Xdistsq  is  (Xdist  *  Xdist), 

Ydistsq  is  (Ydist  *  Ydist) , 

Alreadist  is  Xdistsq  +  Ydistsq, 

(Difdist  >  Alreadist-> 

Newxdist  is  Difdist  -  Ydistsq, 
sqrt (Newxdist,  Nxs)  , 
sqrt (Xdistsq,  Xdis) , 

Pnxs  is  Nxs  -  Xdis, 
maxrow (Mr)  , 

Row  is  ;ws  +  1, 
ad  justrow(Row,  Mr,  Pnxs); 
true)  , 

set t lercon (List )  ,  :  . 
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sett  1 eccon  (ill. 

sett leccon  ([[}]). 

sett leccon ( [Elem I  List ] ) 

Elem  =  con(S,  L,  Rows,  Rowi,  Wids,  Wid!,  Layers,  Layer!,  Difdist), 
f  indistx  (Rows,  Rowl,  Xdist) , 
findisty(S,  L,  Ydist), 

mindiagdist (Xdist,  Ydist,  Layers,  Wids,  Layer!,  Midi,  Dbetob) , 
Difdist  is  (Dbetob  *  Dbetob) , 

Xdistsq  is  (Xdist  *  Xdist), 

Ydistsq  is  (Ydist  *  Ydist)  , 

Alreadist  is  Xdistsq  +  Ydistsq, 

(Difdist  >  Alreadist-> 

Newydist  is  Difdist  -  Xdistsq, 
sqrt (Newydist ,  Nys)  , 
sqrt (Ydistsq,  Ydis) , 

Pnys  is  Nys  -  Ydis, 
maxcol (Me) , 

Col  is  S  +  1, 

ad justcol  (Col,  Me,  Pnys); 

true) , 

settleccon ( [List] ) ,  !. 

%  Stretch  due  to  diagonal  constraints;  note  xdistt  and  ydist  are  not 
%  updated.  The  change  from  xdist  and  ydist  to  hrow  and  hcol  is  to 
%  save  time  (less  frequent  changes,  so  we  don't  pay  as  much  for  having 
%  to  update  all  the  hcols  and  hrows  greater  than  the  hrow  or  hcol  to 
%  be  modified.) 

adjustrow (Row,  Maxrow,  Dist) 

Row  >  Maxrow,  ! . 
ad justrow (Row,  Maxrow,  Dist) 
retract (hrow (Row,  Fdist) ) , 

Ndist  is  Fdist  +  Dist, 

Newrow  is  Row  +  1, 

assert  (hrow (Row,  Ndist)), 

adjust  row (Newrow,  Maxrow,  Dist),  !. 

adjustcol (Col,  Maxcol,  Dist) 

Col  >  Maxcol,  ! . 
adjustcol (Col,  Maxcol,  Dist) 
retract  (hcol  (Col,  Fdist)), 

Ndist  is  Fdist  *  Dist, 

Newcol  is  Col  +  1, 

assert (hcol (Col,  Ndist)), 

ad justcol (Newcol,  Maxcol,  Dist),  1. 

%  determine  the  minimum  distance  possible  between  twe  diagonal,  elements 
mindiagdist  (0,  _,  Layer,  Wid,  Layerf,  Widf,  Dbetob)  ;  - 
mindist  (Layer,  Wid,  Layerf,  Widf,  Dbetcb)  ,  !  . 
mindiagdist  (_,  0,  Layer,  Wid,  Layerf,  Widf,  Dbetob)  : - 
mindist  (Layer,  Wid,  Layerf,  Widf,  Dbetob)  ,  !  . 

mindiagdist (Xdist ,  Ydist,  Layer,  Wid,  Layerf,  Widf,  Dbetob) 
space (Layer,  Layerf,  Dist), 
width (Layer,  Wspace) , 

Widmod  is  (Wid  *  Wspace  *  141421  /  10000C  ), 
width (Layerf ,  Wspacef ) , 

Widfmod  is  (Widf  *  Wspacef  *  141421  /  100000  ), 

Dbetob  is  Dist  +  Widmod  +  Widfmoa,  ! . 


%  double  all  distances  (CIF  hates  fractions; 
doubled 

retract (hcol (Nextcol,  Newdist)), 

Double  is  Newdist*2+1, 
floor (Doubre,  Vnewdist), 
assert (col (Nextcol,  Vnewdist)), 
doubled,  ! . 
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doubled  : - 

retract (hrow (Next  row,  Newdist. ) ) , 
Double  is  Newdist *2+1, 
floor (Double,  Vnewdist), 
assert (row (Next row,  Vnewdist ) )  , 
doubled,  ! . 
doubled . 


split  (H,  [  A I  X] ,  [  A I  Y] ,  Z)  order  (A,  H),  split  (H,  X,  Y,  2). 

split (H,  [AIX],  Y,  [At  Z] )  orderIH,  A),  split (H,  X,  Y,  Z)  . 

split  (_,  [] ,  [  ]  ,  [  i )  . 

quisort ([HIT],  S)  :  - 
split (H,  T,  A,  3), 
quisort  (A,  Al)  , 
quisort  (B,  Bl)  , 
append(Al,  [ H I B X ] ,  S)  . 
quisort  (  [ ] ,  [  ] )  . 

crder(A,  H) 

con(S,  L,  Rows,  Rowl,  Wids,  Widl,  layers,  layerl,  Oifdist)  =  A, 
con (SI,  LI,  Rowsl,  Rowll,  Widsl,  Widll,  Layersl,  Layerll,  Oifdistl) 
isin(S,  L,  SI,  LI),  !. 
order (A,  H) 

con (S,  L,  Rows,  Rowl,  Wids,  Widl,  Layers,  Layerl,  Difdist)  =  A, 
con (SI,  LI,  Rowsl,  Rowll,  Widsl,  Widll,  Layersl,  Layerll,  Difdistl) 
3  =<  Si,  ! . 
order (A,  H) 

term(Side,  Loc,  Lay,  Wid,  Nod)  =  A, 
term(Side2,  Loc2,  Lay2,  Wid2,  Nod2)  =  H, 

Loc  =<  Loc2,  ! . 


layer (p) .  %  Poly 

layer  (ml).  %  Metal  1. 

Iayer(m2).  %  Metal  2. 

layer (nd).  %  N  Diffusion 

layer(pd).  %  P  Diffusion. 

layer  (nw)  .  %  N  Well. 

layer (pw) .  %  P  Well . 

iayer(ccut).  %  Generic  Contact  Cut. 

layer (act ive ) .  %  Active  area 

layer (mlm2).  %  Contact  --  Metal  1  to  Metal  2. 

layer (mlp) .  %  Contact  —  Metal  1  to  Poly. 

%  lambda(l.S).  Lambda  value, 
lambda (X)  X  is  (15/10)  . 

cif layer ( [ml,  mlm2,  mlp],  'CMF'). 

cif layer ( [m2,  mlm2],  'CMS'). 

cif layer ( [active,  nd,  pd],  'CAA'). 

ciflayer([p,  mlp],  'CPG'). 

cif layer ( [nd]  ,  'CSN'). 

cif layer ( [pd] ,  'CSP'). 

cif layer ( [ccut] ,  'CCA'). 

cif layer ( [nw]  ,  'CWN'). 

cif layer ( [pw] ,  'CWP'). 

cif layer ( [mlm2] ,  'CVA'). 

cif layer ( [mlp] ,  'CCP'). 
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%  MOSIS  rules  (in  2  units  per  mosis  unit). 

%  Width  rules  (half  of  actual) 

width  (nd,  2 )  . 

width Inatrans,  2)  . 

width (pdt rans,  2). 

width  (pd,  2)  . 

width (p,  2)  . 

width (m2 ,  3 )  . 

width  (ml,  3,'  - 

width (mlm2,  4)  . 

width (mlp,  4 )  . 

width (mind,  4 )  . 

width (mlpd,  4 ) . 

width (tspot,  2) .  %  same  as  poly 

width (ccut ,  2 )  . 

%  Spacing  rules  (full  distances) 

maxspace(ml,  12). 
maxspace (m2,  16) . 
maxspace(pd,  48). 
maxspace  (nd,  48). 
maxspace (pdtrans,  48). 
maxspace (ndtrans,  48). 
maxspace (p,  12)  . 


maxspace (mlm2. 

16) 

. 

maxspace (mlp. 

12)  . 

maxspace (mind, 

48) 

maxspace \  lpd. 

48) 

« 

space (nd,  nd. 

6)  : 

_  t 

space (nd,  ndtrans, 

6)  : 

_  i 

space (ndtrans. 

ndt 

rans. 

6) 

space (pd,  pd. 

6)  : 

-  !  . 

space (pd,  pdtrans. 

6)  : 

-  ! 

space (pdtrans. 

pdt 

rans. 

6) 

space (ndtrans. 

pdt 

rans. 

6)  :  - 

space (ndtrans. 

pdt 

rans, 

6) 

space (p,  p,  4)  !  . 

space (ml,  ml,  6) 
space (m2,  m2,  8) 


space (ml,  mlm2. 

6)  : 

space (m2,  mlm2. 

8)  : 

space (mlm2,  ml. 

6)  : 

space (mlm2,  m2. 

3)  : 

space 'pd,  nd,  24 

) 

t pace (pa,  ndtrans,  24)  !. 

spacefnd,  pd,  24)  !. 

space (nd,  pdtrans,  24)  !. 

space (ndtrans,  pdtrans,  24)  !. 

space (p,  pd,  4)  !. 

space  (p,  pdtrans,  6)  !.  %p  to  dif  ■*  overhang  distance 

space (p,  ndtrans,  6)  :-  ! .  %d  to  dif  *  overhang  distance 
space (p,  nd,  4)  I. 

space (tspot,  tspot,  6)  !. 

space (tspot,  mlpd,  6)  !. 

space (mlpd,  tspot,  6)  !. 

space (tspot,  pd,  6)  : -  !. 

space (tspot,  nd,  6) 
space (tspot,  pdtrans,  8)  :-  !. 

space (tspot,  ndtrans,  8)  !. 

space (tspot,  mind,  6)  !. 

spacefmlnd,  tspot,  6)  !  . 

space  (p,  tspot,  8) 
space <mlm2,  mlm2,  Dist) 
space (m2,  m2,  Dist),  !  . 
space(mlpd,  mind,  Dist) 
space (pd,  nd,  Dist),  !  . 
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space  (mind,  mipd,  Disc)  : 

space (pd,  na,  Dist),  ! 
space(Ll,  L2,  Dist) 

contlayer (LI,  SLl) , 

contlayer (L2,  _,  3L2)  , 
space (ml,  ml,  Dist),  ! 
space (LI,  ml,  Dist) 

contlayer (LI,  _,  _) , 
space (ml,  ml,  Dist),  ! 
space (ml,  Ll,  Dist) 

contlayer (LI,  _,  _) , 
space (ml,  ml,  Dist), 
space (Ll,  L2,  Dist) 

contlayer (Ll,  _,  Mil), 
space (Mil,  L2,  Dist), 
space (Ll,  L2,  Dist) 

contlayer (L2,  _,  M12) , 
space (Ll,  M12,  Dist), 
space (Ll,  L2,  Dist) 

space (L2,  Ll,  Dist), 

pohang (2)  . 


contlayer (mlm2,  ml,  m2), 
cont layer (mlp,  ml,  p) . 
contlayer (mind,  ml,  nd) . 
contlayer  (rrlod.  ml.  Dd)  . 


diftoed ( 6) . 


%  The  following  code  will  take  in  a  sticks  description  on  a 
%  and  produce  a  CIF  description,  using  a  specified  value  of 
%  The  name  of  output  file  is  X,  without  any  .  extensions. 

genbox 

makebox, 
makeweli, 
makelabel,  ! . 

makebox 

wire  (Layer,  pt(Xi,  Y 1)  ,  pt(X2,  Y2)  ,  Wia,  N'cae)  , 

(var  (Wid)  -> 

Wid  =  1; 
true) , 

get  layer (Layer,  Rlayer) , 

(XI  =  X2  -> 

procxwire (Rlayer,  XI,  Yl,  Y2,  Wid,  Node); 
procywire (Rlayer,  Yl,  XI,  X2,  Wid,  Node)), 
fail,  !. 
makebox 

cont (Type,  pt (Row,  Y) ,  Oset,  _) , 
procont (Type,  pt (Row,  Y) ,  Oset,  _) , 
fail, 
makebox 

trans  (Type,  pt(Sx,  Sy)  ,  pt  (Gx,  Gy),  pt  (Ox,  Dy)  ,  W,  L,  Sn, 
(Sx  =  Dx  -> 

proctrans  (Type,  Gx,  Gy,  W,  L,  x)  ; 
proctrans (Type,  Gx,  Gy,  W,  L,  y) ) , 
fail,  !. 
makebox . 

get  layer (Layer,  Rlayer) 

transtype  (Rlayer,  Layer),  . 
getlayer (Layer,  Layer). 


lambda  grid 
lambda . 


Gn,  Dn) , 
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procxwire (Layer,  Row,  ¥1,  Y2,  Wid,  Node) 
width (Layer,  Minwid) , 

Boxwidt'n  is  4*Minwid*Wid, 
larger (Yl,  Y2,  Ys,  Yl), 
col (Ys,  Sloe) , 
col (Yl,  Lloc) , 
maxcol  (Col)  , 
maxrow (Mrow) , 

(Ys  =:=  0-> 

assert (term (bottom.  Row,  Layer,  Wid,  Node)); 
true) , 

(Yl  =  Col-> 

assert  (term  (top.  Row,  Layer,  Wid,  Node)); 
true) , 

(Row  ■=:  =  0— > 

assert ( jterm ( left ,  Yl,  Y2,  Layer,  Wid,  Node)); 
true) , 

(Row  =  Mrow-> 

assert ( jterm ( right ,  Yl,  Y2,  Layer,  Wid,  Node)); 
true) , 

row  (Row,  Centerx)  , 

Boxlength  is  (Lloc  -  Sloe  +  4*Minwid), 

Centery  is  (Lloc  +  Sloe) / 2, 

assert (pbox (Layer,  Boxwidth,  Boxlength,  Centerx,  Centery)),  !. 

proeywire (Layer,  Col,  XI,  X2,  Wid,  Node) 
width (Layer,  Minwid), 

Boxlength  is  4*Minwid*Wid, 
larger (XI,  X2,  Xs,  XI), 
row (Xs,  Sloe) , 
row (XI,  Lloc) , 
maxrow (Row) , 
maxcoi (Mcol) , 

(Xs  =;=  Q-> 

assert  (termdeft.  Col,  Layer,  Wid,  Node)); 
true) , 

(XI  =  Row-> 

assert (term (right.  Col,  Layer,  Wid,  Node)); 
true) , 

(Col  =:=  0-> 

assert ( j term (bottom,  XI,  X2,  Layer,  Wid,  Node)); 
true) , 

(Col  =  Mcol-> 

assert ( jterm (top,  XI,  X2,  Layer,  Wid,  Node)); 
true) , 

col  (Col,  Centery), 

Boxwidth  is  (Lloc  -  Sloe  +  4*Minwid), 

Centerx  is  (Lloc  +  Sloc)/2, 

assert (pbox (Layer ,  Boxwidth,  Boxlength,  Centerx,  Centery)),  !. 

procont (Type,  pt(X,  Y) ,  Oset,  _) 
contlayer (Type,  Layrl,  Layr2) , 
width (Type,  Minwid), 
width (ccut,  Cminwid) , 

Cwid  is  4  *  Cminwid, 

Boxlength  is  4*Minwid, 
col (Y,  Centery) , 
row (X,  Centerx) , 

(Type  =  mlpd  -> 

assert (pbox (Layrl,  Boxleng' h,  Boxlength,  Centerx,  Centery)) 
assert (pbox (Layr2,  Boxlength,  Boxiength,  Centerx,  Centery)) 
assert (pbox (ccut,  Cwid,  Cwid,  Centerx,  Centery)); 
true)  , 

(Type  =  mind  -> 

assert (pbox (Layrl,  Boxlength,  Boxlength,  Centerx,  Center y) ) 
assert (pbox (Layr2,  Boxlength,  Boxlength,  Centerx,  Centery)) 
assert (pbox (ccut,  Cwid,  Cwid,  Centerx,  Centery)); 
t  rue) , 
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(Type  =  m  I  m2  -> 

assert (pbox (mlm2,  Boxlength,  Boxlength,  Centerx,  Centery) ) 
assert (pbox (ocut,  Cwid,  Cwid,  Centerx,  Centery)); 
true) , 

(Type  =  mlp  -> 

assert (pbox (mlp,  Boxlength,  Boxlength,  Centerx,  Centery)); 
assert (pbox (ccut ,  Cwid,  Cwid,  Centerx,  Centery) ) ; 
true) ,  !  . 

proctrans (Type,  Gx,  Gy,  W,  L,  Orient) 
width (p,  Pwidth) , 
width (Type,  Dwid) , 
pohang (Ohang) , 
row(Gx,  Centerx), 
col (Gy,  Centery), 


Lovw 

is 

L/W, 

large 

r  (1 

,  Lovw, 

Dc, 

Pwid) 

Wovi 

is 

W/L, 

large 

r  (1 

,  Wovi, 

Dcr, 

,  Pht) 

Boxwid  is  4 *Pwid*Pwidth, 

Boxlen  is  4*(Pht*Dwid  +  Ohang), 

(Orient  =  x  -> 

assert (pbox (p,  Boxlen,  Boxwid,  Centerx,  Centery)); 
assert (pbox (p,  Boxwid,  Boxlen,  Centerx,  Centery))),  !. 

makewell 

pbox  (pd,  L,  W,  X,  Y)  , 
diftoed  (Edist)  , 

Newl  is  L  +  Edist  *  4, 

Neww  is  W  t  Edist  *  4, 

(Newl  <  24-> 

Vnewl  =  24; 

Vnewl  =  Newl) , 

(Neww  <  24~> 

Vneww  =  24; 

Vneww  =  Neww) , 

assert (pbox (pw, Vnewl, Vneww, X, Y) ) , 
assert (pbox (active, L, W, X, Y) ) , 
fail . 

makewell  :  - 

pbox  (nd,  L,  W,  X,  Y)  , 
diftced  (Edist)  , 

Newl  is  L  Edist  *  4, 

Neww  is  W  +  Edist  *  4, 

(Newl  <  24-> 

Vnewl  =  24; 

Vnewl  =  Newl), 

(Neww  <  24-> 

Vneww  =  24; 

Vneww  =  Neww) , 

assert  (pbox  (nw,  Vnewl,  Vneww,  X,  Y)  )  , 
assert (pbox (act ive, L,  W,  X,  Y)  )  , 
fail . 
makeweil . 

%makewell 
%  grow (pw) , 

%  mergeboxes, 

%  shrink (pw) , 

%  grow  (nw)  , 

%  mergeboxes, 

%  shrink (nw) ,  \  . 
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makeiabel 


retract  (node  (X,  Y,  Label,  Type)), 

(cont layer (Type,  Layrl,  Layr2>-> 

I layer  =  ml; 

Ilayer  =  Type) , 
row (X,  Xdist ) , 
col (Y,  Ydist ) , 
cif  layer  (Ilayer,  CLayer)  , 

assert (plabel (CLayer,  Xdist,  Ydist,  Laoel)), 
fail. 
maKeiabel 

pinIDir,  pt  (X,  Y)  ,  Type,  Wid,  Laoei,  Name,  Cell 
(contlayer (Type,  Layrl,  Layr2)-> 

Ilayer  =  ml; 

Ilayer  =  Type), 
row (X,  Xdist ) , 
col (Y,  Ydist ) , 
cif layer (Ilayer,  CLayer), 

assert (plabel  (CLayer,  Xdist,  Ydist,  Label)), 
fail. 


)  , 


makeiabel 

pin (pt (X, Y) , Type,  Wid,  Label,  Name) 
(cont layer (Type,  Layrl,  Layr2)-> 
Ilayer  =  ml; 

Ilayer  =  Type)  , 
row (X,  Xdist ) , 
col (Y,  Ydist) , 
cif layer  (Ilayer,  CLayer), 
assert  (plabel  (CLayer,  Xdist,  Ydist, 
fail . 

makeiabel . 


Label ) ) , 


balance 

assert ( lowylO) ) , 
assert ( lowx  (0) ) , 
assert (right  (0) ) , 
assert (top (0) ) , 
shift, 
ad justbox, 
mods,  !  . 

sn.ift 

pbox  (_,  L,  W,  X,  Y), 
xlow (L,  X), 
y low (W,  Y) , 
fail,  !. 
shift . 

xiow(L,  X) 

lowx (Lowx) , 
right (Hix) , 

Newlowx  is  X  -  (L/2) , 
Newhix  is  X  *  (L/2) , 
(Newlowx  <  Lowx-> 
retract  ( lowx  (_)  )  , 
assert (lowx (Newlowx) ) ; 
true) , 

(Newhix  >  Hix-> 

retract  (right  (_)  )  , 
assert (right (Newhix) ) ; 
true),  !. 
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ylow(W,  V) 

lowy (Lowy) , 
cop  (Hiy)  , 

Newlowy  is  Y  -  (W/2) , 
Newhiy  is  Y  +  (W/2), 
(Newlowy  <  Lowy-> 
retract ( lowy (_) ) , 
assert  ( lowy  (Newlowy)  )  ; 
true) , 

(Newhiy  >  Hiy-> 

retract  (top  (_)  )  , 
assert (top (Newhiy) ) ; 
true)  ,  . 


adjustbox 
lowy (YS) , 
lowx (XS) , 

£  retract  (pbox  (D,  L,  W,  X,  Y)  )  , 

Newx  is  (X  -  XS) , 

Newy  is  (Y  -  YS) , 

assert (box (D,  L,  W,  Newx,  Newy)), 
fail,  ! . 
adjustbox 
lowy (YS) , 
lowx(XS), 

£  retract (plabel (CLayer,  Xdist,  Ydisc,  '  .  1)), 

Newx  is  (Xdist  -  XS), 

Newy  is  (Ydist  -  YS) , 

assert (label (CLayer,  Newx,  Newy,  Label)), 
fail,  !. 
adjustbox 
lowy (Ly) , 
lowx (Lx) , 

%  retract (right  (Chix) ) , 

retract (top(Ohiy) ) , 

Newx  is  (Ohix  -  Lx) , 

Newy  is  (Ohiy  -  Ly) , 
assert (right (Newx) ) , 
assert (top (Newy) )  ,  !. 

mods 

4P  lowx (Lx) , 

row (Row,  Val) , 

NewVal  is  (Val-Lx), 
assert (trow (Row,  NewVal)), 
fail,  !  . 
mods  : - 

lowy (Ly) , 
col  (Col,  Val)  , 

^  NewVal  is  (Val-Ly) , 

assert  (tcol  (Col,  NewVal)), 
fail,  !. 
mods . 


expand  (Name) 

open_f ile (Name) , 
writecellbegin (Name,  1), 
wr iteboxes, 
writelabels, 
writecellend,  ! . 

%Take  boxes  from  database  and  write  out  CXF  file, 
writeboxes 

ci  flayer (Layerl ist,  Layername), 
write('L  '),  write  (Layername)  ,  write!';'), 
writeboxesl (Layerlist) , 
fail . 

writeboxes . 


nl. 


asp  •  19 


compactor 


writeboxesl  ( !  1 )  . 
writeboxesl ( [Layer i Res' j ) 

box  (Layer,  L,  W,  X,  Y)  , 
write ( ' B  ' ) , 
write  (L)  ,  write!'  '), 
write  ( W)  ,  write  ('  '  )  , 
write(X),  write(' 
write (Y),  write(';'), 
nl , 
fail . 

writeboxesl ([ Layer  I  Rest ] ) 
writeboxesl (Rest ) ,  !. 


% 

% 

% 

% 


remove  (X,  Y,  Label,  Type) 

retract (node (X, Y, Label, Type) ) , 
fail,  !  . 

remove  (X,  Y,  Label,  Type)  . 


%  writelabels 

%  node (X, Y, Label, Type) , 

%  assert (onode (X, Y, Label, Type) ) , 

%  remove (X, Y, Label, Type) , 

%  writelabels. 


writelabels 

label (Clayer,  Xdist,  Ydist,  CLabel) , 
write  ('94  '),  write  (CLabel)  , 
tab(l),  write (Xdist ) , 
tab(l),  write ( Ydist) , 

write!'  '),  write  (Clayer)  ,  write!';'),  nl, 
fail . 

writelabels. 


%Write  out  definition  start  line  of  CIF  cell, 
writecellbegin (X,  N) 
lambda (L) , 

A  is  L*100, 
write ( ' DS' ) , 
write (N) , 
write ( '  ' ) , 
write (A) , 
write  ( '  4  ; '  )  , 
nl, 

write!' 9  '),  write(X),  write!';'),  nl.  %Module  name. 


%Fetch  lambda  value. 

%Find  first  scale  factor. 

%Hard  wired  cell  number  for  now. 

%First  scale  factor. 

^Second  scale  factor. 


%Write  end  cell  definition  instruction  on  CIF  file, 
writecellend 

write ( ' DF; ' ) ,  nl, 
write ( ' C  1 ; ' ) ,  nl , 
write ( ' End' ) ,  nl , 
told,  !  . 


lOpen  file  with  .cif  extension. 
open_file(X) 


name  (X,  L)  , 
append (L, " . cif " , 
name ( Y, LI) , 
tell (Y)  . 


LI)  , 


writef ile (Name) 

writespace (Name) , 
writebbox (Name) , 
name (Name,  SO) , 
append (SO,  ”.bdr“, 
name  (Namel,  SI)  , 
tell  (Namel)  , 
wr iteterm (Name) , 
writedge (Name) , 
told,  !  . 


SI)  , 
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wri  tespace  (Name)  :  - 
name (Name,  SO) , 
append (SO,  " . space",  SI), 
name (Name  1 ,  SI), 
tell (Name  1 ) , 
writex  (0,  Name) , 
wr itey (0,  Name) , 
writerc  (Name)  ,  , 

told. 

writebbox (Name) 
name (Name ,  SO ) , 
append(S0,  ".bbox",  SI), 
name (Name  1 ,  SI), 
te  1  1  (Namel)  , 
wr i tep in (Name) , 
writerc  (Name)  ,  !  , 

told. 

wr  i  tep  in  (Ce  1  1  name ) 

pin (Dir,  pt (X,  Y) ,  Layer,  Wld,  Node,  Nane,  Cellname), 
t  row (X,  Xloc) , 
tool (Y,  Yloc) , 

P-pln(Dlr,  pt (Xloc,  Yloc),  Layer,  Wid,  Node,  Nane,  Cellname) 
wr lte  (P )  , 
write!'  . '  )  , 
n  1, 

fail,  !. 

wrltepln (Cellname) 

pin (pt (X,  Y) ,  Layer,  Wid,  Node,  Nane), 
trow (X,  Xloc) , 
tco  l  ( Y,  Yloc) , 

flndwire(X,  Y,  Layer,  Wld,  Node,  Dir), 

P-pln (D lr ,  pt (Xloc,  Yloc),  Layer,  Wid,  Node,  Nane,  Cellname) 
wr lte (P) , 
write  ('.')  , 
n  1 , 

fail,  !  . 

wr i tep in (Ce 1 Iname) . 

flndwire(X,  Y,  Layer,  Wid,  Node,  Dir) 

wtred.ayer,  pr.  (X,  Y)  ,  pt  (Ox,  Oy)  ,  Wid,  None), 
findirfX,  Ox,  Y,  Oy,  Dir),  !. 
ftndwiro(X,  Y,  Layer,  Wld,  Node,  Dir) 

wire (Layer,  pt (Ox,  Oy)  ,  pt(X,  Y) ,  Wid,  Node). 
flndir(X,  Ox,  Y,  Oy,  Dir),  !. 

flndlrtx,  X,  Y,  Oy,  loy) 

Y  -  0. 

findlr(X,  X,  Y,  Oy,  hly)  . 

flndlrlX,  Ox,  Y,  Y,  lox) 

X  -  0. 

t  ind  1  r  ( X,  Ox,  Y,  Y,  hix)  . 

writexIRl,  Cellname) 
maxrow (Rmax)  , 

HI  >  Rmax,  ! . 
writex(Rl,  Cellname) 

R2  is  Rl  t  1, 
t row (R 1 ,  D 1 st ) , 

Z  -  row(Rl,  Dist,  Cellname), 
write  (Z) , 
wr  1  te  ( '  . '  )  , 

nl, 

writex(R2,  Cellname),  !. 
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: 

writey(Cl,  Ceiiname) 

maxcol (Cmax) ,  £ 

Cl  >  Cmax,  !  . 
writey(Rl,  Ceiiname) 

R2  is  R1  +  1, 
tcol  (Rl,  Dist) , 

Z  =  col(Rl,  Dist,  Ceiiname), 
write  (Z ) , 
write  ( '  . ' ) , 

nl,  # 

writey(R2,  Ceiiname),  !. 


xmatch(Xloc) 

retract (xdist (XI,  X2,  Dist)), 

Newxl  is  XI  x  Xloc, 

Newx2  is  X2  +  Xloc, 

xresolve (Newxl,  Newx2,  Dist),  £ 

fail,  !. 
xma  .ch  (Xloc)  . 

xresolve(Xl,  X2,  Dist) 

retract (gxdist (XI,  X2,  Gdist)), 
larger (Dist,  Gdist,  Dontcare,  Ndist), 
assert (gxdist (XI,  X2,  Ndist)),  !. 

xresolve (XI,  X2,  Dist)  0 

assert (gxdist (XI,  X2,  Dist)),  !. 


ymatch (Yloc) 

retract (ydist (Yl,  Y2,  Dist)), 

Newyl  is  Yl  +  Yloc, 

Newy2  is  Y2  +  Yloc, 

yresolve (Newyl,  Newy2,  Dist),  0 

fail,  !. 
ymatch  (Yloc)  . 

yresolve (Yl,  Y2,  Dist) 

retract (gydist (Yl,  Y2,  Gdist)), 
larger (Dist,  Gdist,  Dontcare,  Ndist), 
assert (gydist (Yl,  Y2,  Ndist)),  !. 

yresoive(Yl,  Y2,  Dist)  ® 

assert (gydist (Yl,  Y2,  Dist)),  !. 


geterm(Bdr,  Bl,  B2,  [EllTerms]) 

termIBdr,  X,  Layer,  Width,  Node), 
in (X,  Bl,  B2) , 

termstr(X,  Layer,  Width,  Node,  El), 
retract (term (Bdr,  X,  Layer,  Width,  Node)), 
getermfBdr,  Bl,  B2,  Terms),  (. 
geterm(Bdr,  Bl,  B2,  []). 

in (X,  Bl,  B2 ) 

X  >=  Bl, 

X  =<  B2. 

termstr(X,  Layer,  Width,  Node,  [X,  Layer,  Width,  Node)). 

seterm(Tbl,  Lrl,  Ntbl,  Nlrl) 

retract (term(Side,  Grid,  Layer,  Wid,  Node)), 

Term  =  termISide,  Grid,  Layer,  Wid,  Node), 
addlist (Side,  Term,  Tbl,  Lrl,  Newtbl,  Newlrl), 
seterm (Newtbl,  Newlrl,  Ntbl,  Nlrl),  !. 
seterm(Tbl,  Lrl,  Tbl,  Lrl). 

addlistltop.  Term,  Tbl,  Lrl,  [TermlTbl],  Lrl). 
addl 1st (bottom.  Term,  Tbl,  Lrl,  [TermITbl],  Lrl). 
addl  ist ( left.  Term,  Tbl,  Lrl,  Tbl,  [TermILrl]). 
addlist (right.  Term,  Tbl,  Lrl,  Tbl,  [TermILrl)). 
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wr iteterm (Name ) 

ret ract ( j term (Bar ,  Bl,  32,  Layer,  Wid,  None) 
geterm(Bdr,  Bl,  32,  Terms), 

Z  =  ceil  (Name,  jterm  (Bdr,  Bl,  32,  Layer,  Wid, 
write (2 ) , 
write  ( '  . '  )  , 
nl, 

fail,  !. 
wri teterm (Name) 

seterm([],  [],  Tbl,  Lrl)  , 
sorterm(Tbl,  Stbl)  , 
sorterm(Lrl,  sirl)  , 

2  -  cell (Name, tbct, Stbl) , 
write (Z) , 
write  ('.'), 
nl, 

S  =  cell  (Name,  1  r it ,  Sir  1)  , 
write  (S) , 
write  ( '  . ' )  , 
nl,  !  . 

writeterm (Name) . 

spliterm(H,  [AIX],  [  A I  Y]  ,  Z)  orderterm(A,  H) 

spliterm(H,  [AIX],  Y,  CAIZ1)  orderterm(H,  A) 

spliterm (_,  []  ,  []  ,  (] )  . 

sorterm( [H IT] ,  S) 

spliterm(H,  T,  A,  B)  , 
sorterm  (A,  Al)  , 
sorterm  (B,  Bl)  , 
append (Al,  [HIB1],  S) . 
sorterm ( ( ] ,  ( ] ) . 

orderterm(A,  H) 

term(Side,  Grid,  Layer,  Wid,  Node)  =  A, 
term(Side2,  Grid2,  Layer2,  Wid2,  Node2)  »  H, 
Grid  =<  Grid2,  ! . 

distoside (bottom.  Grid,  Col) 
tool  (Grid,  Col)  ,  !  . 

distoside  ( left ,  Grid,  Row) 
trow (Grid,  Row) ,  ! . 

distoside (top.  Grid,  Idist) 
maxcol (Tc) , 
tcol  (Tc,  Top)  , 
tcol  (Grid,  Col)  , 

Idist  is  Top  -  Col  ,  ! . 

distos ide ( right ,  Grid,  Idist) 
maxrow (Tr ) , 
trow (Tr,  Right ) , 
trow(Grid,  Row)  , 

Idist  is  Right  -  Row,  ! . 

side  (top)  . 
side  (bottom)  . 
side  (left )  . 
side  (right) . 

vert (top) . 
vert (bottom) . 

listypes (dif ) . 
listypes (p) . 
listypes (ml) . 
listypes (m2) . 


Node,  Terms) ) , 


,  spliterm (H,  X,  Y,  Z) 
,  spliterm(H,  X,  Y,  Z) 
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C ruebo  rd ( S ide ,  t ] ,  I  ;  )  . 

t  ruebc rd  ( 3  ide,  ;E lement - List ' ,  ■  EL  New  1  1st.  \  ) 

listio  (Layer,  PI,  P2,  Wid,  Node,  Grid,  El 
maxspace ( Layer ,  Sdist), 
width (Layer,  Wdist), 

Edged  is  2  *  Wdist  *  Wid, 

Dist  is  Sdist  *  Edged, 
distoside (Side,  Grid,  Bspace), 

Id, st  is  Dist  -  Bspace, 

Id i st  >  0 , 

bel  (Layer,  Wid,  Pi,  ?2,  Grid,  None,  EL), 
t  rtiefcord  (Side,  List,  Newiist), 

t  ruebord  (Side,  iE iemer.t  ;  List  (  ,  Newiist)  :  - 
t  ruebord  ( S  ide.  List.,  Newiist). 

oel (Layer,  Wid,  PI,  ?2,  Grid,  Node,  EL) 

EL  =  (Layer,  Wid,  PI,  ?2,  Grid,  Ncoej,  (. 

writedge (Name) 
s ide (S ide ) , 
i istypes (Layer) , 
border(Side,  Layer,  List), 
truebord (Side,  List,  Newiist), 

Z  =  bound(Side,  Layer,  Newiist,  Name), 
write  (Z) , 
wr i te  ( '  . ' )  , 
nl, 

fail,  !. 

writedge (Name) . 

writerc (Name) 

writebound (Name) , 
maxrow (Row) , 

Z  «  maxrow(Row,  Name), 
maxw  -  (Co  1 )  , 

P  =  maxcoltCoi,  Name), 
top  (Hix) , 

0  -  hiy (Hix,  Name) , 
r ight (Hiy ) , 

D  ■  hix (Hiy,  Name) , 
wr  i  te  ( Z ) , 
write!'  .')  , 

write ( P / , 
wr ite ( '  . ' ) , 
ni, 

write  (Q) , 
write  ('.')  , 
n  1 , 

write (D) , 
write!'  . '  )  , 


wri rebound (Name) 

rowbcund  (Libound,  HiDorna) , 

Z  -  xoound  ( Libound,  Hiiicund,  Name), 
wr  i te  ( Z )  , 
write!'  . '  ) , 
n  i , 

colbound (Lcbound.  Hcbound), 

A  »  ybound  ( Lcbound,  Hcoound,  Name), 
wr ite (A) , 
write!'  .  '  )  , 


em.ent )  , 
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writebound (Name) 

maxrow (Maxrow) , 
maxcol (Maxcol) , 
trow  (0,  R0)  , 
trow(Maxrow,  Rm)  , 
tcoi  (0,  CO), 
tcoi (Maxcol,  Cm) 
R  =  rowbound(R0, 
write (R) , 
write  ( '  . '  )  , 
nl, 

C  =  co ibound  (CO , 
write (C) , 
write ( '  . '  )  , 
nl,  !  . 


Rm,  Name ) , 


Cm,  Name) , 


prpr  (  [  ]  )  : -  nl . 

prpr(tH!T])  write(H), 


tab  (1)  ,  prt 


clears  : - 

retract (row (  ,  _) ) , 
fail,  !. 
clears 

retract  (col  (_,  _)  )  , 
fail,  !  . 
clears . 

symbfile 

clears, 

setsymbrow (0,  0) , 

setsymbcol (0,  0),  !. 

setsymbrow (Row,  Val) 
maxrow  (Maxrow)  , 

Row  >  Maxrow,  !  . 
setsymbrow (Row,  Val) 

assert (row (Row,  Val)), 
Newrow  is  Row+l, 

NewVax  is  Val+50, 

set symbrow (Newrow,  NewVal), 

setsymbcol  (Col,  Val) 
maxco 1 (Maxcol)  , 

Col  >  Maxcol,  !  . 
setsymbcol (Col,  Val) 

assert (co 1 (Col ,  Val)), 
Newcol  is  Col+1, 

NewVal  is  Val+50, 
setsymbcol (Newcol,  NewVal) , 


ptobox 

retract  (poox  (D, 


L,  W,  X,  Y)  ) 


assert  (box(D,  L,  W,  X,  Y)  i 


fail,  !. 
ptobox . 

isinIPs,  PI, 

Bs, 

31) 

Ps  > -  Ss, 
PI  =<  Bl, 

t 

isin(Ps,  PI, 

Bs, 

Bl)  :  - 

PI  >=  Bs, 
PI  =<  Bl, 

;  _ 

isin  (Ps,  PI, 

Bs, 

Bl) 

Pi  >=  Bl, 
Ps  -<  3s, 

growfactor (1 

2)  . 

r  (T)  . 
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grow(Layer) 

growfactor (Grow) , 

retract (mwbox (Layer,  Wid,  Len,  X,  Y)  )  , 

Newid  is  Grow  *  (Wid/2) , 

Newle  is  Grow  +  (Len/2) , 

XI  is  X-Newid, 

Yl  is  Y-Newle, 

X2  is  X+Newid, 

Y2  is  Y+Newle, 

assert (gbox (pt (XI ,  Yl)  ,  pt(X2,  Y2))), 
fail,  ! . 
grow (Layer) . 

mergeboxes 

retract  (gbox  (pt  (XI,  Yl)  ,  pt(X2,  Y2))), 
findwithin (XI,  Yl,  X2,  Y2,  Gxl,  Gyl,  Gx2,  Gy2), 
assert ( fbox (pt (Gxl,  Gyl),  pt (Gx2,  Gy2) ) ) , 
mergeboxes,  ! . 
mergeboxes . 

findwithin (Ixl,  lyl,  1x2,  Iy2,  Gxl,  Gyl,  Gx2,  Gy2) 
gbox(pt(Xlg,  Ylg)  ,  pt  (X2g,  Y2g)  )  , 
checkin (Xlg,  Ylg,  X2g,  Y2g,  Ixl,  lyl,  1x2,  Iy2) , 
larger (Ixl,  Xlg,  Smxl,  Del), 
larger (lyl,  Ylg,  Smyl,  Dc2) , 
larger (1x2,  X2g,  Dc3,  Lgx2) , 
larger (Iy2,  Y2g,  Dc4,  Lgy2) , 
retract (gbox (pt (Xlg,  Ylg),  pt (X2g,  Y2g) ) ) , 
findwithin (Smxl,  Smyl,  Lgx2,  Lgy2,  Gxl,  Gyl,  Gx2,  Gy2), 
findwithin (XI,  Yl,  X2,  Y2,  XI,  Yl,  X2,  Y2)  . 

checkin (Xlg,  Ylg,  X2g,  Y2g,  XI,  Yl,  X2,  Y2) 
smaller (XI,  Yl,  X2g,  Y2g) , 
smaller (X2g,  Y2g,  X2,  Y2),  !. 

smaller (Xlg,  Ylg,  XI,  Yl) 

Xlg  =<  XI; 

Ylg  =<  Yl. 

shrink (Layer) 

growfactor (Grow)  , 

retract (fbox (pt (XI,  Yl),  pt (X2,  Y2))), 

Wid  is  X2-Xl-2*Grow, 

Len  is  Y2-Y1-2 ‘Grow, 

Cx  is  (X2  +  XI) / 2, 

Cy  is  ( Y2  +  Yl)/2, 

assert (pfcox (Layer,  Wid,  Len,  Cx,  Cy) )  , 
fail,  !. 
shrink (Layer) . 


larger (El,  E2,  E2, 

El)  :  - 

El  >  E2,  !  . 

larger(El,  E2,  El, 

E2)  . 

append  (  [ ] ,  L,  L)  . 
append ( (X  I  LI ] ,  L2 , 

[  X  !  L3  ]  ) 

append (LI,  L2, 

L3I  . 

rev(Ol,Nl) 

nrev  (01 ,  [  ] ,  Nl)  . 

nrev ( [], Result , Result )  . 
nrev ( [H I T] , Sofar, Result ) 

nrev(T, [H I Sofar ], Result) . 


* 
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^option  " 

>  compactor  uses  fioor/2  and  sqrt/'2.  If  one  of 

> 

v  C_PL  QUINTUSJPL 
> 

>  is  selected,  then  appropriate  definitions  for 

>  fioor/2  and  sqrt/2  are  included  automatically. 

*  if  C_PL 
floor (X,  I)  : - 
I  is  f 1 oor (X) . 


sqrt(X,  Y)  : - 
Y  is  sqrt (X) . 

felseif  QUIN" 

US_PL 

:  - 

multifile 

t  mp 1 / 1 . 

:  - 

multifile 

tmp2/ 1 . 

:  - 

multifile 

tmp3/l . 

:  - 

multifile 

tmp4 / I . 

:  - 

multifile 

wire/5 . 

multifile 

cont/4 . 

:  - 

mu  1 1  i  f  i  le 

pin/5 . 

multifile 

pin/ 6 . 

:  - 

multifile 

pin/7  . 

:  - 

multifile 

pbox/5 . 

:  - 

multifile 

trans/9 . 

multifile 

node/ 4 . 

:  - 

multifile 

tmpRowNum/1 

:  - 

multifile 

tmpColNum/1 

:  - 

multifile 

box/5 . 

:  - 

multifile 

rowbound/2 . 

:  - 

multifile 

rowbound/3 . 

multifile 

maxrow/1. 

:  - 

multifile 

maxcol/1. 

multifile 

nwire/5 . 

:  - 

multifile 

ntrans/9 . 

:  - 

multifile 

ncont/4 . 

:  - 

multifile 

npin/6 . 

:  - 

multifile 

ncol/2 . 

:  - 

multifile 

col/2. 

:  - 

multifile 

nrow/2 . 

:  - 

multifile 

row/2 . 

:  - 

multifile 

nbox/5 . 

:  - 

multifile 

nlabei/4 . 

multifile 

label/ 4  . 

:  - 

multifile 

nwire/5 . 

:  - 

multifile 

nnode/ 4 . 

:  - 

multifile 

nccnt/4  . 

multifile 

node/4  . 

multifile 

term/5 . 

:  - 

multifile 

jterm/6 . 

:  - 

multifile 

placel/4 . 

:  - 

multifile 

lowx/1 . 

:  - 

multifile 

right ' 1 . 

:  - 

multifile 

lowy/1 . 

multifile 

top/ 1 . 

multifile 

gethpic/4 . 

:  - 

multifile 

get vpic/ 4 . 

:  - 

multifile 

tyconst /8 . 

:  - 

multifile 

ei  ist /2 . 
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-  dynamic  tmpl/1. 

-  dynamic  tmp2/l. 

-  dynamic  Cmp3/1. 

-  dynamic  tm.p4/l. 

-  dynamic  wire/5. 

-  dynamic  cont/4. 

-  dynamic  pin/5. 

-  dynamic  pin/6. 

-  dynamic  pin/7. 

-  dynamic  pbox/5. 

-  dynamic  trans/9. 

-  dynamic  node/4. 

-  dynamic  tmpRcwNum/1. 

-  dynamic  tmpColNum/l . 

-  dynamic  box/5. 

-  dynamic  rowbound/2. 

-  dynamic  rowbound/3. 

-  dynamic  maxrow/i. 

-  dynamic  maxcol/1. 

-  dynamic  nwire/5. 

-  dynamic  ntrans/9. 

-  dynamic  ncont/4. 

-  dynamic  npin/6. 

-  dynamic  ncol/2. 

-  dynamic  col/2. 

-  dynamic  nrow/2. 

-  dynamic  row/2. 

-  dynamic  nbox/5. 

-  dynamic  nlabel/4. 

-  dynamic  label/4. 

-  dynamic  nwire/S. 

-  dynamic  nnode/4. 

-  dynamic  ncont/4. 

-  dynamic  node/4. 

-  dynamic  term/ 5. 

-  dynamic  jterm/6. 

-  dynamic  plabel/4. 

-  dynamic  lowx/1. 

-  dynamic  right/1. 

-  dynamic  lowy/1. 

-  dynamic  top/1. 

-  dynamic  gethpic/4. 

-  dynamic  getvpic/4. 

-  dynamic  tyconst/8. 

-  dynamic  elist/2. 

ensure_loaced ( 1 ibrary (math) ) .  %  ffioor/2,  sqrt/2 

f  loor  ( X,  I)  : - 
f floor (X,  Y) , 

I  is  integer  (Y)  . 

#else 

#  message  "WARNING:  floor/2  and  sqrt/2  must  be  defined" 
ttendif 
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wirelml,  pt(0,0),  pt  (5, 0)  ,  1,  *)  . 
wirelml,  pt(l,0),  pt  (1,  2)  .  1, 1)  - 
wirelml,  pt(0,10),  pt  (5,  10) ,  1,  2)  . 
wirelml,  pt(l,10),  pt  (1, 8)  ,  1, 2)  . 
wirelml,  pt(3,8),  pt  (3, 2)  ,  1,  3)  . 
wirelml,  pt(3,6),  pt  (5,  6)  ,  1, 3)  . 
wirelp,  pt(2,8),  pt  (2,  2)  ,  1,  4)  . 
wirelp,  pt  (0,  6)  ,  pt  (2,  6)  ,  1,  4 )  . 
translnd,  pt(l,2),  pt(2,2),  pt(3,2), 
trar.slpd,  pt(l,8),  pt(2,8),  pt{3,8), 
cont (mind,  pt(l,2),  na,  1). 
cont (mind,  pt(3,2),  na,  3). 
cont (mipd,  pt(l,8),  na,  2). 
cont  (mlpd,  pt(3,3),  na,  3). 
pinltop,  (0,  6),  p,  1,  4). 
pin  (bottom,  (5,  6),  ml,  1,  3)  . 
maxrow (5) . 


maxcol (10 ) . 


4, 

2, 


2,  1,  4,  3) 
2,  2,  4.  3] 
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(p,  pt  (1,2)  ,pt  (11,2)  , _57055 ,  colorbus)  . 
(p,pt (1,5) ,pt (11, 5) ,_57252,p3) . 

(p,  pt  (1,8)  ,pt(ll,8)  , _5 7453,  valid)  . 

(p,pt  (1,  10)  ,pt  (11,  10)  , _57654,  colorbus)  . 
(p,  pt  (1, 12) ,  pt  (11, 12) ,  _57855,  colbusbar)  • 
(p, pt (1, 14), pt (11, 14), _5 8056, attacked). 
(p,pt  (1, 17)  ,pt  (11, 17)  ,_58257,p3)  . 

(p,  pt (1, 20 )  ,  pt ( 11 , 20) , _584  58, valid)  . 

(p,pt  (1,22)  ,pt  (11,22)  ,_58659,  colbusbar)  . 
(p,pt  (1,24) ,  pt  (11,24)  ,_58860,  colorbus)  . 
(p,pt  (1,26)  ,pt  (11,26)  ,_5  9061,  attacked)  . 
(p,pt  (1,2  9)  ,pt  (11,29)  ,_592  62,p3bar)  . 

(ml,  pt  (3,0)  ,  pt  (3,5)  ,  _59478,  P3)  . 

(ml,pt  (3,5)  ,pt  (3,  17)  ,_59797,p3)  . 

(ml,  pt  (3,28)  ,pt  (3,30)  ,_60120,  whiteact )  . 
(ml,  pt  (3,  30)  ,pt  (3, 31)  ,_6C4  4  3,_36238)  . 

(m2,  pt (10, 28) , pt  (3,  28 )  ,  60  7 62 ,  whiteact )  . 
(m2,pt (1,  30) ,pt (3,30) , _61085, _3 623 8 )  . 

(ml,  pt  (4,0)  ,  pt  (4, 8)  ,  _6 14 08,  valid)  . 

(ml,  pt  (4,  8)  ,  pt  ( 4, 20;  ,  _61727,  valid)  . 
(ml,pt(5,0),pt(5,2),_62050,colorbus). 

(ml,  pt  (5,  2)  ,  pt (5, 10) , _623  65, colorbus)  . 
(ml,  pt (5, 10) , pt (5, 24 ) , _62684, colorbus) . 
(ml,  pt  (6,  0)  ,  pt  (6,  14)  ,  _63007,  attacked)  . 
(ml,  pt  (6, 14) ,  pt  ( 6,  26) ,  _6332  6,  attacked)  . 
(ml,  pt  (7,  1)  ,  pt  (7,  12)  ,_63 7 8 8,  colbusbar)  . 
(ml,  pt  (7, 12)  ,  pt  (7, 22)  ,  _64107,  colbusbar)  . 
(m2,  pt  (10, 1)  ,pt  (7, 1)  ,  _64 430,  colbusbar)  . 
(m2,  pt  (2,  1)  ,  pt  (7,  1)  ,  _64745,  colbusbar)  . 
(ml,  pt  (8,  4 ) ,  pt  (8,29),  _65203,p3bar)  . 

(m2,pt  (10,  4)  ,pt  (8,  4)  ,_6552  6,p3bar)  . 

(m2,  pt  (2,  4)  ,  pt  (8, 4)  ,_6584  9,  p3bar)  . 

(ml,  pt (9,  16) , pt ( 9, 18) ,  _66172, blackact ) . 
(ml.pt  (9,  18)  ,pt  (9,31)  ,_66495,_28140)  . 

(m2,  pt (10,  16) , pt (9,  16) ,  66814, blackact) . 
(m2,  pt  (1,  18)  ,pt  (9,18)  , _67 137,  _28 14 0)  . 

(pd,  pt  (1,  1)  ,  pt  (0, 1)  ,  _674  60 ,  vdd)  . 

<na,pt  (11,  1)  ,pt  (12,  1)  ,_67775,gnd)  . 

(ml,  pt  (2,  1)  ,pt  (2,  3)  ,_680  90,  colbusbar)  . 
(pd,pt(l,3),pt(2,3),_68405,  colbusbar)  . 
(ml,  pt  (10,  1)  ,pt  (10,  3)  ,_6 8720,  colbusbar)  . 
(nd,pt (11,  3) , pt (10, 3) , _69035, colbusbar) . 
(pd,pt(l,4),pt(0,4),_69350,  vdd)  . 

(nd,pt  (11,  4)  ,pt  (12,  4)\_69673,gnd)  . 

(ml.pt  (2,  4)  ,  pt  (2,  6)  ,_69996,p3bar)  . 

(pd,  pt  (1,  6)  ,  pt  (2 , 6)  ,  _7  0319,  p3bar)  . 
(ml,pt(10,4),pt(10,6),_70642,p3bar). 

(nd,  pt  (11,  6)  ,pt  (10,  6)  ,  _70965,  p3barl  . 
(pd,pt  (1,  11)  ,pt  <0, 11)  ,_71288,  vdd)  . 

(nd,pt (11, 13) ,pt (12, 13) , _71611, gnd) . 

(nd,  pt  (11,  16)  ,  pt  (12, 16) ,  _71934 ,  gnd)  . 
(ml.pt  (1,  7)  ,pt  (1,  15)  ,_72S43,gl)  . 

(ml.pt  (1,  15)  ,pt  (1, 16)  ,_728  70,gl)  . 

(ml.pt  (11,  7)  ,pt  (11,  11)  ,_73197,g4)  . 

(ml,pt  (11,  ll),pt  (11, 15),_73S24,g4)  . 

(ml,  pt (10, 9), pt (10, 18), _7 3851, blackact). 
(nd,  pt (11,  9)  ,  pt (10,  9) , _7 4174 , blackact ) . 
(ml,  pt (11, 18), pt (10, 18), _74497, blackact)  , 
(pd,  pt  (1,  23)  ,pt  (0,23)  ,_74 822,  vdd)  . 

(nd.pt  (11,  25)  ,pt  (12, 25)  ,_7514  5,gnd)  . 

(nd,  pt (11, 28) , pc (12, 28) ,_75463, gnd)  . 
(ml.pt  (1,  19)  ,pt  (1,27)  ,_76077,gS)  . 

(ml,pt  (1, 27)  ,pt  (1,28)  ,_76404,g5)  . 

(ml.pt  (11,  19)  ,pt  (11, 23)  ,_76731,g8)  . 

(ml.pt  (11,2  3),  pt  (11,27  ),_77058,g8)  . 

( rr.  i,  pt  <10, 21),  pt  (10,  30),  _7  7385,  whiteact) 
(nd.pt (11,21) ,pt (10, 21) ,_7 7 708,  whiteact) 
(ml.pt  (11,30)  ,pt  (10,  30)  ,_78031,  whiteact)  . 
(ml,  pt  (1,  0) ,  pt  (1,  32) ,  _56809,  vdd)  . 

Mml.pt  (12,0)  ,pt  (12,  32)  ,_5 6810,  gnd)  . 
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node (3, 0, p3,ml) . 
node (3,5, p3,mlp) . 
node (3, 5, p3, mlp) . 
node  (3, 17,  p3,  mlp)  . 
node (3, 28, whiteact ,  mlm2)  . 
node (3, 30,  _36238, mlm2) . 
node (3,30,_36238,mlm2) . 
node (3, 31, whiteact, ml) . 
node (10, 28, whiteact, mlm2) . 
node (3, 28 , whiteact ,  mlm2 )  . 
node (1,30,_36238,  mlm2 )  . 
node (3, 30, _36238, mlm2) . 
node (4 , 0, valid,  ml)  . 
node (4, 8, valid, mlp) . 
node (4 , 8 , valid, mlp) . 
node (4 , 20 , valid, mlp) . 
node (5, 0, colorbus,ml) . 
node (5,2, colorbus, mlp) . 
node (5, 2, colorbus,  mlp) . 
node (5, 10,  colorbus, mlp) . 
node (5, 10, colorbus, mlp) . 
node (5, 24, colorbus, mlp) . 
node (6,0, attacked,  ml) . 
node (6, 14 , attacked,  mlp)  . 
node ( 6, 14 , attacked, mlp) . 
node (6, 26, attacked, mlp) . 
node (7, 1, colbusbar, mlm2) . 
node (7, 12, colbusbar, mlp) . 
node (7, 12, colbusbar, mlp) . 
node (7, 22, colbusbar, mlp) . 
node ( 10, 1, colbusbar, mlm2) . 
node (7, 1, colbusbar, mlm2) . 
node (2, 1, colbusbar, mlm2) . 
node (7, 1, colbusbar, mlm2) . 
node (8,4, p3bar, mlm2) . 
node(8,29,p3bar,mlp)  . 
node (10,4, p3ba  r , mlm2 )  . 
node (8,4, p3bar, mlm2) . 
node (2, 4, p3bar, mlm2) . 
node (8 , 4 , p3bar, mlm2) . 
node ( 9, 16, blackact , mlm2 ) . 
node (9, 18 , _28 140 , mlm2 ) . 
node ( 9, 18, _28140 , mlm2 ) . 
node (9, 31, blackact , ml) . 
node (10,  16, blackact, mlm2) . 
node (9, 16, blackact, mlm2) . 

node ( 1 , 18, _ 2  8  7 40, mlm2) . 

node (9, 18, _28140, mlm2) . 
node  (1, 1,  vdd,  pd)  . 
node (0, 1, vdd, mlpd)  . 
node  ( 11,  1,  gnd,  nd)  . 
node (12, 1, gnd, mind) . 
node (2, 1, colbusbar, mlm2) . 
node (2, 3, colbusbar, mlpd) . 
node (1, 3, colbusbar, pd) . 
node (2, 3, colbusbar, mlpd) . 
node ( 10, 1, colbusbar, mlm2) . 
node ( 10, 3, colbusbar, mind, . 
node (11,  3, colbusbar, nd)  . 
node ( 10, 3 , colbusbar , mind) . 
node  (1,4,  vdd,  pd )  . 
node (0, 4 , vdd, mlpd) . 
node  (11,4,  gnd,  nd)  . 
node (12, 4, gnd, mind) . 
node  (2, 4,  p3bar,  mlm2 )  . 
node (2, 6, p3bar, mlpd) . 
node (1, 6, p3bar, pd)  . 
node (2, 6, p3bar, mlpd)  . 
node (10, 4 , p3bar, mlm2) . 
node ( 10, 6, p3bar, mind) . 
node (11, 6, p3bar, nd)  . 
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node (10, 6, p3bar, mind) . 
node (1,11, vdd , pd) . 
node (0, 1 1, vdd, mlpd)  . 
node (11,13, gnd , nd ) . 
node (12, 13 , gnd, mind) . 
node (11, 16, gnd, nd) . 
node  (12,  16,  gnd,  mind)  . 
node (1, 7, gl, mlpd) . 
node ( 1, 15, gl, mlpd)  . 
node  (1, 15,  gl,  mlpd)  . 
node (1 , 16, gl, mlpd)  . 
node  (11,  7,  g4,  mind) . 
node (11, 11,  g4, mind)  . 
node (11, 11, g4, mind) . 
node ( 11, 15, g4 , mind)  . 
node (10, 9, blackact , mind) . 
node  (10,  18,  blackact ,  ml)  . 
node (11, 9, blackact, nd) . 
node ( 10, 9, blackact , mind) . 
node (11, 18, blackact , mind) . 
node (10, 18, blackact , ml) . 
node (1, 23, vdd, pd)  . 
node (0, 23, vdd, mlpd) . 
node ( 11, 25, gnd, nd)  . 
node (12, 25, gnd, mind)  . 
node (11, 28, gnd, nd) . 
node (12,  28, gnd, mind)  . 
node ( 1, 19, g5,  mlpd)  . 
node ( 1, 27, g5, mlpd) . 

:  ode  (l,27,g5,mlpd)  . 
node (1, 28, g5, mlpd)  . 
node ( 11, 19, g8, mind) . 
node (11, 23, g8, mind)  . 
node  (11,  23,  g8,  mind)  , 
node (11, 27, g8, mind) . 
node (10, 21, whiteact, mind) . 
node (10, 30, whiteact, ml)  . 
node ( 11, 21, whiteact , nd) . 
node ( 10, 21, whiteact , mind) . 
node ( 11, 30, whiteact , mind) . 
node (10, 30, whiteact,  ml)  . 
node (1,0, vdd) . 
node (1,32, vdd) . 
node (12, 0, gnd) . 
node (12, 32, gnd) . 

trans (pd, pt  (1, 1) ,pt (1, 2) , pt (1, 3) , 1, 1, vdd, colorbus, colbusbar )  . 
trans  (nd,pt  (11,  l),pc  (11,2)  ,pt  (11, 3),  1,1,  gnd,  colorbus,  colbusbar)  . 
trans  (pd,pt(l,4),pt(l,5),pt(l,6),l,  1,  vdd,  p3,  p3bar)  . 
trans  (nd,  pt  (11,  4)  ,  pt  (11,  5)  ,pt  (11,  6)  ,  1, 1,  gnd,  p3,p3bar)  . 
trans  (pd,  pt  (1,  7)  ,pt  (1, 8) ,  pt  (1,  9) ,  1,  l,gl,  valid,  g3)  . 
trans  (pd,  pt  (1,  9)  ,  pt  (1, 10 )  ,  pt  ( 1,  11)  ,  1, 1 ,  g3,  colorbus,  vdd)  . 
trans  (pd,pt(l,ll),pt(l,12),pt(l,13),l,  1,  vdd,  colbusbar,  g2)  . 
trans  (pd,  pt  (1, 13) ,  pt  (1,  14)  ,pt  (1, 15)  ,  1,  1,  g2,  attacked,  gl)  . 
trans  (pd,pt  (1, 16),  pt  ( 1,  17),  pt  (1,181,1, 1,  gl,  p3,  blackact )  . 
trans  (nd,  pt  (11,  7)  ,  pt  (11, 8)  ,  pt  (11,  9)  ,  1,  1,  g4,  valid,  blackact)  . 
trans  (nd,pt(ll,9),pt(ll,10),pt(ll,ll),l,  1,  blackact,  colorbus,  g4)  . 
trans  (nd,pt(ll,ll),pt(ll,12),pt(ll,13),l,l,  g4,  colbusbar,  gnd)  . 
trans  ( nd,pt  (11,  13),  pt  (11, 14),  pt  (11,151,1,  1,  gnd,  attacked,  g4)  . 
trans  (nd,  pt(ll,16),pt(ll,17),pt(ll,18),l,  1,  gnd,  p3,  blackact )  . 
trans  (pd,  pt(l, 19), pt(l, 20), pt(l, 21), l,l,g5,val  id, g7). 
trans  (pd,  pt  (1,  21),  pt  (1,  22),  pt  (1, 23 ,1,1,  g7,  colbusbar,  vdd)  . 
trans  (pd,pt(l,23),pt(l,24),pt(l,25),l,  1,  vdd,  colorbus,  g6)  . 
trans  (pd,  pt  (1, 25)  ,  pt  (1, 26) ,  pt  (1, 27)  ,  1,  1,  g6,  attacked,  g5)  . 
trans  (pd,pt(l,28),pt(l,29),pt(l,30),l,l,  g5,p3bar,  whiteact)  . 
trans  (nd,pt(ll,19),pt(ll,20),pt(ll,21),l,  1,  g8,  val  id,  whiteact )  . 
trans (nd, pt (11, 21) , pt (11, 22) , pt (11, 23) , 1, 1, whiteact , colbusbar , g8) 
trans  (nd,pt  (11, 23)  ,pt  (11,24)  ,pt  (11, 25)  ,  1,  l,g8,  colorbus,  gnd)  . 
trans  (nd,  pt  (11, 25)  ,  pt  (11,26)  ,  pt  (11, 27)  ,  1,  l,gnd,  attacked,  g8)  . 
trans  ( nd,pt  (11, 28),  pt  (11, 29),  pt  (11,301,1,  1,  gnd,  p3bar,  whiteact )  . 
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cont (mlpd, pt (2,3), no, colbusbar) . 
cont  (mlm2,  pt  (2,1),  r.o,  colbusbar)  . 
cont (mind, pt (10, 3) , no, colbusbar) . 
cont  (min, 2,  pt  (10,  1)  ,  no,  colbusbar)  . 
cont (mind, pt (12 , 1) , no, gnd)  . 
cont  (mlpd,  pt  (0,  1)  ,  no,  vdd)  . 
cont (mlpd, pt (2 , 6) , no, p3bar ) . 
cont (mlm2,  pt (2, 4) , no, p3bar) . 
cont  (mind,  pt(10,6),no,p3bar)  . 
cont  (mlm2,pt  (10,  4)  ,no,p3bar)  . 
cont (mind, pt (12 , 4) , no, gnd)  . 
cont (mlpd,pt (0, 4) , no, vdd) 
cont (mlpd, pt (1, 7) , no, gl)  . 
cont (mlpd, pt ( 1 , 15) , no, gl ) . 
cont  (mlpd,  pt(l,16),no,gl). 
cont (mind, pt (11, 7) , no, g4 )  . 
cont (mind, pt (11, 11) , no, g4 ) . 
cont (mind,  pt ( 11, 15) , no, g4)  . 
cont (mind, pt (11, 18) , no, black act) . 
cont (mind, pt ( 10 , 9) , no , blackact ) . 
cont (mlm2, pt ( 1 0, 16) , no, blackact ) . 
cont (mind, pt ( 12, 13) , no,  gnd)  , 
cont  (mlnd,pt(12,16),no,  gnd)  . 
cont (mlpd, pt (0, 11) , no, vdd)  . 
cont (mlpd, pt (1, 19) , no,g5) . 
cont (mlpd, pt (1, 27) , no, g5)  . 
cont (mlpd, pt (1, 28) , no, g5)  . 
cont (mind, pt ( 11, 19) , no, g8) . 
cont (mind, pt ( 11, 23 ) , no, g8) . 
cont  (mind,  pt(ll,27),no,g8)  . 
cont (mind, pt (11, 30) , no,  whiteact ) . 
cont (mind, pt (10, 21) , no, whiteact) . 
cont (mlm2, pt (10, 28) , no, whiteact) . 
cont (mind, pt ( 12, 25) , no, gnd) . 
cont (mind, pt (12, 28) , no, gnd) . 
cont (mlpd, pt (0,23) , no, vdd) . 
cont (mlp, pt (5, 2) , no, colorbus)  . 
cont  (mlp,  pt  (3, 5)  ,  no,  p3)  . 
cont  (mlp,  pt(4,8),no,valid)  . 
cont (mlp, pt (S, 10) , no, colorbus)  . 
cont (mlp, pt (7, 12) , no, colbusbar)  . 
cont (mlp, pt (6, 14 ) , no, attacked) . 
cont (mlp,  pt (3, 17) , no,  p3 )  . 
cont (mlp,  pt (4, 20) , no, valid) . 
cont (mlp,  pt (7, 22) , no, colbusbar) . 
cont(mlp,pt(5,24),no,  colorbus)  . 
cont (mlp,  pt (6,26) , no, attacked)  . 
cont (mlp,  pc (8, 29) , no, p3bar) . 
cont (mlm2, pt (3, 28) , no, whiteact) . 
cont  (mlm2,  pt  (3,  30)  ,no,_3  6238)  . 
cont (mlm2, pt (7, 1) , no, colbusbar) . 
cont (mlm2, pt (7, 1) , no, colbusbar) . 
cont  (mlm2,  pt(8,4),no,p3bar)  . 
cont (mlm2, pt (8, 4) , no, p3bar) . 
cont (mlm2 , pt ( 9, 16) , no, blackact ) . 
cont  (mlm2,  pt(9,18),no,_28140)  . 
maxrow (12) . 
maxcol (32) . 


asp  *33 


sml  .m 


»  /* 

sml.m:  benchmark,  (viper)  sml  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s) :  $ _ OPTIONS _ $ 

% 

%  (viper)  sml 
% 

%  The  ASP  Group 
% 

%  (contact:  3ill  Bush 
%  Computer  Science  Division 

%  University  of  California 

%  Berkeley,  CA  94720 

%  bush@ophiuchus.Berkeley.EDU) 

% 

%  run  viper  on  simple  microprocessor  specification  (sml) 

#if  BENCH 

#  include  “ . sml .bench" 

♦else 

sml  :-  reconsult (' examples/ in/ sml ') , 
viper (' examples/out/sml' )  . 

#opt ion  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

#  if  SHOW 

show. 

#  endif 
#endi f 

#if  QUINTUS_PL 

:-  multifile  execute/1,  fetch/0,  run/0. 

:-  dynamic  execute/1,  fetch/0,  run/0. 

♦endi f 

((option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (viper/1)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
#if  DUMMY 

viper  (_)  . 

((else 

#  include  "viper"  /*  code  for  viper  */ 

tendif 
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*  /* 

viper:  code  for  ASP  viper  coiroor.er.t 

*/ 

%  (c)  1988  Regents  of  Che  University  of  California 

% 

%  Viper  is  the  high-level  synthesis  component  of  the  ASP  (Advanced 
%  Silicon  compiler  in  Prolog)  system  developed  at  the  University  of 
%  California,  Berkeley.  Viper  generates  structural  hardware  de- 
%  scriptions  from  instruction-set  level  specifications  written  in 
%  standard  Prolog.  It  translates  Prolog  constructs  into  hardware 
%  equivalents  and  creates  and  allocates  hardware  resources  while 
%  satifying  various  constraints. 

% 

%  Viper  operates  in  four  phases:  register  allocation,  translation 
%  of  the  Prolog  specification  into  an  RTL-based  form,  data  path 
%  construction,  and  structural  description  generation. 

% 

%  For  a  detailed  explanation  of  viper,  see  W.  Bush  et  al.,  "A 
%  Prototype  Silicon  Compiler  in  Prolog,"  University  of  California 
%  (Technical  Report  UCB/CSC  98/496),  Berkeley,  California.  1988. 

% 

%  Five  output  files  are  generated  from  a  specification  file  name: 

% 

%  namebus 

%  namegoto 

%  namertl 

%  namesched 

%  nameunit 

% 

%  When  show/0  is  provable,  viper  produces  output  (intended  for 
%  a  terminal  screen)  indicating  its  progress. 


#op tion  n 

>  For  use  with  Quintus  Prolog,  viper  requires  some 

>  Quintus  Prolog-specific  directives.  These  are 

>  generated  if  option  QUINTUS_PL  is  selected.” 

# if  QUINTUS_PL 

:-  no_style_check (single_var) . 

:-  unknown (_,  fail). 

:  -  op (400,  fx,  \)  . 


♦endi f 
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%**  Viper  top  level 

viper (Name)  : - 

scan  (transfer,  run,  0), 
makeFileName (Name,  rtl,  Nl), 
scanWrite (Nl) , 

(show  ->  ni,  write (' Register  Transfers...'),  nl,  nl  ;  true), 
sched, 

makeFileName (Name,  sched,  N2), 
schedWrite (N2)  , 

(show  ->  nl,  write (' Schedule ...') ,  nl,  nl  ;  true), 
branch, 

makeFileName (Name,  goto,  N3), 
branchWrite (N3)  , 

(show  ->  nl,  write (' Branches ...') ,  nl,  nl  ;  true), 
alloc, 

makeFileName (Name,  unit,  N4), 
al locWrite (N4 )  , 

(show  ->  nl,  write (' Functional  Units...'),  nl,  nl  ;  true), 
conn, 

makeF i leName (Name,  bus,  N5) , 
connWr ite (N5 )  , 

(show  ->  nl,  write  (' Buses ...')  ,  nl,  nl  ;  true). 


makeFileName (Root,  Number,  Symbol) 
name (Root ,  RL) , 
name (Number,  NL) , 
makeFileString (RL,  NL,  SL) , 
name  (Symbol,  SL)  . 

makeFileString ([] ,  X,  X) 

makeFileString ( (Al B] ,  C,  (AID))  makeFi leSt r i ng (B,  C,  D) . 


%*  utility 

%* 

flus.n  (Functor,  Arity) 

abolish (Functor,  Arity). 


%**  Scan  Prolog,  instantiating  variables 

%**  (declare  all  scanned  procedures  dynamic) 

%’*  data  base  items 
%  *  scanlndex (<root>, <index>) 

%  *  v  (c  (p  ( <name> ,  <arity>),<c  lause-ir.dex> )  ,  <  va  r  iable-index> ) 

%*  scanPass (<pass-name> ) 

%*  scanErr  r (<pass-name>, <type-of-error>! 

%'  transfer  generation  pass 

transferSrc (<register>, <variable>) 

%*  transferExp (<srcl>,<src2>,<op>,<dst>) 

%  *  transferDst(<register>, <var iab le> ) 

%'  transfer (< id>, <biock>,<srcl>,<src2>, <op>, <dst reg>) 

%*  <register>  ::=  <register-name>  I  constant (<atom>) 

%*  I  field (<register-name>, <field-name>) 

%*  label  and  jump  generation 

%*  label (<clause-name>, <tag>, <biock>) 

%  *  jump (<block>, <type>, <clause-name>) 

%*  <type>  case  I  cond  I  jrst 

%*  main  routine,  invoked  with  prime  clause  functor  and  arity 
scan (Pass,  ProcFunctor,  ProcArity) 

(show  ->  write(’>>>  '),  write(Pass),  nl,  nl  ;  true), 

flush (scanPass,  1), 

assert  (  (  scanPass  (Pass)  )), 

scan  Initialize, 

scanClauses  !p (ProcFunctor,  ProcArity),  ProcFunctor,  ProcArity) 
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scanCiauses (ProcName,  ProcFuncccr,  ? rccArity) 

functor  (ClauseHead,  PrccFur.ctcr,  PrccArity), 
clause (ClauseHead,  Clause3cdy)  , 
scanNewNam.e  (c,  ProcName,  ClauseName), 
scanClause (ClauseName,  ClauseHead,  Clause3ody) , 
fail . 

scanCiauses (_,  _) . 

scanClause (ClauseName,  ClauseHead,  ClauseBody) 

%  case  arm  (indicated  by  arity  1) 
scanPass (transfer! , 
functor (ClauseHead,  i) ,  !, 

scanArgs (ClauseName,  ClauseHead,  1), 
scanNewBlock (ClauseName,  ClauseHead) , 
scanGoal (ClauseName,  ClauseBody) , 

%  add  jump  to  end  of  case  arm 
scanOldName (end,  EndLabel) , 
scanJump ( j rst,  EndLabel), 

(show  ->  write (ClauseHead) ,  nl  ;  true),  ! . 
scanClause (ClauseName,  ClauseHead,  ClauseBody) 
scanPass  (transfer)  , 
functor (ClauseHead,  _,  0),  !, 

scanArgs (ClauseName,  ClauseHead,  1), 
scanOldBlock (ClauseName) , 
scanGoal (ClauseName,  ClauseBody) , 

(show  ->  write (ClauseHead) ,  nl  ;  true),  !. 
scanClause (ClauseName,  ClauseHead,  ClauseBody) 
scanArgs (ClauseName,  ClauseHead,  1), 
scanGoal (ClauseName,  ClauseBody) , 

(show  ->  write (ClauseHead) ,  nl,  tab(4),  write (ClauseBody ) ,  nl 

true 
)  ,  !  . 

scanArgs (ClauseName,  ClauseHead,  Arglndex) 

arg (Arglndex,  ClauseHead,  ClauseHeadArg) , 
scanArg (ClauseName,  ClauseHeadArg) , 

Newlndex  is  Arglndex  +  1, 

scanArgs (ClauseName,  ClauseHead,  Newlnaex) . 
scanArgs (_,  _,  _) . 

scanArg (_,  Arg) 

atomic (Arg) ,  ' . 

scanArg (ClauseName,  Arg) 
var(Arg),  !, 

scanVariable (ClauseName,  Arg) . 
scanArg (C lauseName ,  v (C iauseName ,  _) ) 

j 

scanArg (ClauseName,  [L]) 

(show  ->  write ('...  List  argument  '),  write (L), 
write!'  in  '),  wr  ite  (C  IauseName )  ,  nl 

true 
I  , 

scanPass  (Pass)  ,  assert!  (  scar.Error  (Pass,  list)  )),  !. 

scanArg 'ClauseName,  S)  : - 

(show  ->  write!'...  Structure  argument  '),  write (S), 
write!'  in  '),  write (ClauseName) ,  nl 


true 
)  , 

scanPass (Pass) ,  assert  (  (  scanError (Pass,  structure)  )),  !. 

%  and  ( , )  terms 

scanGoal (C lauseName ,  (Goal,  Goals)) 
scanGoa  1  (C lauseName ,  Goal), 
scanGoal  (ClauseName,  Goals),  !. 
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%  or  (;)  terms 

scanGoal (ClauseName,  (Goal;  Goals)) 

(show  ->  write  ('...  or  '  )  ,  write  (Goal),  ni  ;  true), 
scanPass (Pass) ,  assert  ((  scanError (Pass,  or)  )), 
scanGoal (ClauseName,  Coal), 
scanGoal (ClauseName,  Goals),  !. 

%  if-then  (->) 

scanGoal (ClauseName,  (Goal  ->  Goals))  :- 

(show  ->  write  ('...  if  '  )  ,  write(Goal),  ni  ;  true), 
scanPass (Pass) ,  assert  (  (  scanError (Pass,  if)  )), 
scanGoal (ClauseName,  Goal), 
scanGoal (ClauseName,  Goals),  !. 

%  not 

scanGoal (ClauseName,  not ( InnerGcai ) )  :- 

(show  ->  write  ('...  not  '),  write  ( Inr.erGoai)  ,  ni  ;  true), 
scanPass (Pass) ,  assert  (  (  scanError (Pass,  not)  )), 
scanGoal (ClauseName,  InnerGcai) ,  !. 

%  is 

scanGoal (ClauseName,  (Leftside  is  RightS.de))  :- 
scanPass  (transfer)  ,  !, 

scanVariable (ClauseName,  Leftside) , 
scanNumerics (ClauseName,  RightSide,  Leftside). 
scanGoal (ClauseName,  (Leftside  is  RightSide!)  :- 
scanVariable (ClauseName,  Leftside) , 
scanNumeric (ClauseName,  RightSide),  !. 

%  comparison  (=:=) 

scanGoal (ClauseName,  (Leftside  =:=  RightSide)) 

scanComparison (ClauseName,  (Leftside  =:=  RightSide)),  !. 

%  comparison  (>) 

scanGoal (ClauseName,  (Leftside  >  RightSide))  :- 

scanComparison(ClauseName,  (Leftside  >  RightSide)),  !. 

%  comparison  (<) 

scanGoal (ClauseName,  (Leftside  <  RightSide))  :- 

scanComparison (ClauseName,  (Leftside  <  RightSide)),  !. 

%  comparison  (=<) 

scanGoal (ClauseName,  (Leftside  =<  RightSide)) 

scanComparison (ClauseName,  (Leftside  =<  RightSide)),  !. 

%  comparison  (>=) 

scanGoal (ClauseName,  (Leftside  >=  RightSide)) 

scanComparison (ClauseName,  (Leftside  >=  RightSide)),  !. 

%  cut 

scanGoal  (ClauseName,  !)  . 

%  r.„il  goal 

scanGoal (ClauseName,  true)  !. 

%  fail 

scanGoal (ClauseName,  fail)  !. 

%  assert 

scanGoal (ClauseName,  assert ( InnerGoal ) ) 

(show  ->  write!'...  assert  '),  write (InnerGoal) ,  nl  ;  true), 
scanPass (Pass) ,  assert  (  (  scanError (Pass,  assert)  )), 
scanGoal (ClauseName,  InnerGoal),  !. 

%  retract 

scanGoal (ClauseName,  retract (InnerGoal) )  :- 

(show  ->  write ('...  retract  '),  write (InnerGoal) ,  nl  ;  true), 
scanPass (Pass) ,  assert (  (  scanError (Pass,  retract)  )), 
scanGoal (ClauseName,  InnerGoal),  ! . 

%  debugging  goals 

scanGoal (ClauseName,  write!  )) 

» 

scanGoal (ClauseName,  tab(_)) 

i 

scanGoal (ClauseName,  nl) 

f 

%  general  Viper-specific  goals 
scanGool (_,  mem_read) 

scanPass  (transfer)  ,  !, 
scanNewName (rt ,  ID), 
scanOldName (block.  Block), 

assert ( (  transfer (ID,  Block,  memAR,  none,  memread,  memDR)  )). 
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scanGoai  (C  lauseN'ame,  mem_reao) 

scanGoai  (_,  me.~_write) 

scanPass  (transfer)  ,  !, 

scanNewName (rt ,  ID), 
scanOldName  (block.,  Block), 

assert (  !  transferllD,  Block,  memAR,  memDR,  mem_write,  none)  )). 
scanGoai (ClauseName,  mem_write) 

scanGoai (ClauseName,  stateDefine) 

j 

scanGoai (ClauseName,  st at elnit ia 1 ize) 


scanGoai (_,  stateUpdate) 

scanPass  (transfer)  ,  !, 

scanOldName (rt ,  ID), 
scanOldName (block.  Block), 
assert  (  (  scanUpdatePost (ID,  Block)  )). 
scanGoai (ClauseName,  stateUpdate) 


scanGoai (ClauseName,  stateList) 


scanGoai (ClauseName,  statePrint) 

j 

scanGoai (ClauseName,  stateCount (_) ) 

j 

%  access 

scanGoai (ClauseName,  access (Register,  Variable) ) 
scanPass  (transfer)  ,  !, 

scanVariaoie (ClauseName,  Variable) , 
assert  (  (  transferSrc (Register,  Variable)  )). 
scanGoai (ClauseName,  access (Register,  Variable)) 
scanVariable (ClauseName,  Variable),  !. 
scanGoai (ClauseName,  access (Register,  Field,  Variable)) 
scanPass  (transfer) ,  !, 

scanVariable (ClauseName,  Variable) , 

scanGoai (ClauseName,  access ( f ie Id (Register,  Field), 
scanGoai (ClauseName,  access (Register,  Field,  Variable)) 
scanVariable (ClauseName,  Variable) ,  !. 


Variable) ) . 


%  set 

scanGoai (ClauseName,  set (Register,  Variable)) 
scanPass  (transfer!  ,  !, 

scanVariable (ClauseName,  Variable ) , 
scanSet (ClauseName,  Register,  Variable). 
scanGoai (ClauseName,  set (Register,  Variable)) 
scanVariable (ClauseName,  Variable) ,  ! . 

scanGoai (ClauseName,  set (Register,  Field,  Variable) )  •- 

scanPass  (transfer)  ,  !, 

scanVariable (ClauseName,  Variable) , 

scanSet (ClauseName,  field (Register,  Field),  Variable). 
scanGoai (ClauseName,  set (Register,  Field,  Variaale)) 
scanVariable (ClauseName,  Variable),  !. 

%  general  goal 
scanGoai (ClauseName,  Goal) 

%  case  (indicated  by  goal  arity  1) 

scanPass (transfer) , 

functor  (Goal,  ProcName,  1),  !, 

%  add  case  dispatch 
scanJump (case,  p(ProcName,  1)), 
scanNewName (end,  EndLabel), 
scanActuals (ClauseName,  Goal,  1), 
scanCall (Goal) , 

%  add  label  at  end  of  case 
scanNewName (block.  Block), 
assert  (  (  label (EndLabel,  none.  Block)  )). 
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scanGoal (ClauseName,  Goal) 

%  tail  recursion 
scanPass  (transfer)  , 

scanRecursion  (ClauseName,  Goal),  , 
scanArgs (ClauseName,  Goal,  1), 
functor (Goal,  GoalFunctor,  GoalArity), 

scanProcedure (p (GoalFunctor,  GoalArity),  GoalFunctor,  GoalArity), 
scanJump ( jrst,  c (p (GoalFunctor,  GoalArity),  1)). 
scanGoal (ClauseName,  Goal) 

scanArgs (ClauseName,  Goal,  1), 
scanCall  (Goal)  ,  !  . 

scanComparison (ClauseName,  Expression) 
scanPass  (transfer) ,  !, 

scan.NewName  (control.  Name), 

scanNumerics (ClauseName,  Expression,  Name), 
transferExp (SrcVarl,  SrcVar2,  Op,  Name), 
scanTransfer (SrcVarl,  SrcVar2,  Cp,  Name,  control), 

ClauseName  =  c(ProcName,  ThisClause) , 

NextClause  is  ThisClause  +  1, 
scanJump (cond,  c (ProcName,  NextClause)), 
scanNewBlock (Name,  none). 
scanComparison (ClauseName,  Expression) 
argil,  Expression,  Leftside), 
arg(2.  Expression,  RightSide) , 
scanNumeric (ClauseName,  Leftside) , 
scanNumeric (ClauseName,  RightSide),  !. 

%  atomic 

scanNumeric (_,  Object) 

atomic (Object) ,  ! . 

%  variable 

scanNumeric (ClauseName,  Object) 
var (Object) ,  ! , 

scanVariable (ClauseName,  Object),  !. 

%  touched  variable 

scanNumeric (ClauseName,  v (ClauseName,  _) ) 

I 

%  addition  (+) 

scanNumeric (ClauseName,  (Leftside  +  RightSide)) 
scanNumeric (ClauseName,  Leftside) , 
scanNumeric (ClauseName,  RightSide),  !. 

%  subtraction  (-) 

scanNumeric (ClauseName,  (Leftside  -  RightSide)) 
scanNumeric (ClauseName,  Leftside) , 
scanNumeric (ClauseName,  RightSide),  !. 

%  unary  minus  (-) 

scanNumeric (ClauseName,  (-  InnerGoal)) 

scanNumeric (ClauseName,  InnerGoal),  !. 

%  multiplication  (*) 

scanNumeric (ClauseName,  (Leftside  *  RightSide)) 
scanNumeric (ClauseName,  Leftside) , 
scanNumeric (ClauseName,  RightSide),  !. 

%  division  (/) 

scanNumeric (ClauseName,  (Leftside  /  RightSide)) 
scanNumeric (ClauseName,  Leftside) , 
scanNumeric (ClauseName,  RightSide),  !. 

%  and  ( / \ ) 

scanNumeric (ClauseName,  (Leftside  /\  RightSide)) 
scanNumeric (ClauseName,  Leftside) , 
scanNumeric (ClauseName,  RightSide),  !. 

*  or  ( \ / ) 

scanNumeric (ClauseName,  (Leftside  \/  RightSide)) 
scanNumeric (ClauseName,  Leftside! , 
scanNumeric (ClauseName,  RightSide),  !. 

%  left  shift  (<<) 

scanNumeric (ClauseName,  (Leftside  <<  RightSide)) 
scanNumeric (ClauseName,  Leftside) , 
scanNumer ic (C lauseName ,  RightSide),  ). 
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%  right  shift  (>>) 

scanNumer ic (ClauseName,  (Leftside  >>  RightSidel I 
scanNumeric (ClauseName,  Leftside) , 
scanNumeric (ClauseName,  RightSide),  !. 

%  complement  (\) 

scanNumeric (ClauseName,  (\  InnerGoal)) 

scanNumeric (ClauseName,  InnerGoal),  !. 

%  default 

scanNumer ic (ClauseName,  Object) 

(show  ->  write ('...  unknown  numeric  in  '),  write (ClauseName) ,  nl 

true 

),  !, 

scanPass (Pass) ,  assert (  (  scanError (Pass,  numeric)  )). 

scanVariable (ClauseName,  Object) 
var (Object ) ,  ! , 

scanNewName ( v,  ClauseName,  Object)  . 
scanVariable (ClauseName,  Object) . 

scanCall (ClauseGoal) 

functor (ClauseGoal,  ProcFunctor,  ProcArity), 

scanProcedure (p (ProcFunctor,  ProcArity),  ProcFunctor,  ProcArity). 

%  1)  already  processed 
scanProcedure (ProcName,  _,  _) 
scanPass  (Pass)  , 
scanlndex (ProcName,  _) ,  !. 

%  2)  unit-ground  clause 

scanProcedure (ProcName,  ProcFunctor,  ProcArity) 
scanUnit  (ProcFunctor,  ProcArity) ,  ! , 

scanPass  (Pass)  , 

assert  (  (  scanlndex (ProcName,  0)  )). 

%  3)  recurse 

scanProcedure (ProcName,  ProcFunctor,  ProcArity) 

functor (ClauseHead,  ProcFunctor,  ProcArity), 
clause (ClauseHead,  _) ,  !, 

scanClauses (ProcName,  ProcFunctor,  ProcArity). 

%  4)  unknown 

scanProcedure  (ProcName,  _,  _) 

(show  ->  write ('...  unknown  procedure  '),  write (ProcName) ,  nl 

true 

),  !, 

scanPass (Pass) ,  assert  (  (  scanError (Pass,  procedure)  )). 

scanUnit (ProcFunctor,  ProcArity) 

functor (ClauseHead,  ProcFunctor,  ProcArity), 
clause (ClauseHead,  true),  ! , 
scanGround (ClauseHead,  1,  ProcArity). 

scanGround (_,  Arglndex,  ClauseArity) 

Arglndex  >  ClauseArity,  ! . 
scanGround (ClauseHead,  Arglndex,  ClauseArity) 
arg (Arglndex,  ClauseHead,  Arg) ,  ! , 
atomic (Arg) , 

Newlndex  is  Arglndex  +  1, 

scanGround (ClauseHead,  Newlndex,  ClauseArity). 

%* 

%*  transfer-specifc  procedures 
%* 

scanActuals (ClauseName,  ClauseHead,  Arglndex) 

arg (Arglndex,  ClauseHead,  ClauseHeadArg) , 
scanActual (ClauseName,  ClauseHeadArg) , 

Newlndex  is  Arglndex  1, 

scanActuals (ClauseName,  ClauseHead,  Newlndex). 
scanActuals (_,  _,  _) . 
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scanActuai (_,  Variable) 

transferSrc (SrcReg,  Variable), 

\+  (CransferDst  (_,  Variable)),  !, 

scanTransfer (Variable,  none,  case.  Variable,  control). 
scanActuai (ClauseName,  Arg) 

scanVariable (ClauseName,  Arg),  . 

%  simple  transfer  --  register  <-  constant  via  "is" 
scanNumerics (ClauseName,  Object,  Result) 
functor (Object,  Constant,  0), 
nonvar (Result) ,  !, 

scanTransfer (Ob ject,  none,  move.  Object,  Result). 

%  simple  object  --  result  is  seif 
scanNumerics (ClauseName,  Object,  Object) 
functor (Ob ject.  Constant,  0),  !. 

%  unary  operator 

scanNumerics (ClauseName,  Expression,  Result) 
functor (Expression,  Op,  1),  !, 

argil.  Expression,  SubExpression) , 
scanExp (SubExpression,  none,  Op,  Result). 

%  binary  operator 

scanNumerics (ClauseName,  Expression,  Result) 
functor (Expression,  Op,  2),  !, 

argil,  Expression,  Leftside), 
arg(2.  Expression,  RightSide), 
scanExp (Leftside,  RightSide,  Op,  Result). 

%  simple  expression,  destination  known 
scanExp (Leftside,  RightSide,  Op,  Destination)  :~ 
nonvar (Destination) ,  !, 

assert  (  (  transferExp (Leftside,  RightSide,  Op,  Destination)  )). 
%  expression  using  temporaries 
scanExp (Leftside,  RightSide,  Op,  Destination) 
scanNewName (temp.  Destination), 

assert ( (  transferSrc (Destination,  Destination)  )),  !, 

scanTransfer (Leftside,  RightSide,  Op,  Op,  Destination). 

%  1)  an  expression:  exp  ->  reg 

scanSet (ClauseName,  DstReg,  DstVar) 

transferExp (SrcVarl,  SrcVar2,  Op,  DstVar),  ! , 
scanTransfer (SrcVarl ,  SrcVar2,  Op,  DstVar,  DstReg). 

%  2)  a  simple  transfer:  reg  ->  reg  or  constant  ->  reg 

scanSet (ClauseName,  DstReg,  Variable)  :- 
transferSrc (SrcReg,  Variable),  !, 

scanTransfer (Variable,  none,  move.  Variable,  DstReg). 

scanTransfer (SrcVarl,  SrcVar2,  Op,  DstVar,  DstReg)  :- 
scanNewName (rt ,  ID), 
scanOldName (block.  Block), 
scanTransferSrc (SrcVarl,  SrcRegl) , 
scanTransferSrc (SrcVar2,  SrcReg2) , 
assert (  (  transferDst (DstReg,  DstVar)  )), 

assert  (  (  transfer(ID,  Block,  SrcRegl,  SrcReg2,  Op,  DstReg)  )), 

scanTransferSrc (Variable,  Register) 

transferSrc (Register,  Variable),  !. 
scanTransferSrc  (none,  none). 

scanTransferSrc (Constant,  constant (Constant) ) . 

scanNewBlock (Name,  ClauseHead) 

scanTag (ClauseHead,  Tag), 

Name  =  c(ProcName,  _) , 
label (c (ProcName,  _) ,  Tag,  _) ,  !, 
scanNewName (block.  Block), 
assert  ( (  label (Name,  none.  Block)  )). 
scanNewBlock (Name,  ClauseHead)  :- 
scanTag (ClauseHead,  Tag), 
scanNewName (block.  Block), 
assert  ((  label (Name,  Tag,  Block)  )),  !. 
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scanOldBlock (Name) 

\+  (scanlndex (block,  _) ) ,  ! , 

assert ( (  scanlndex (block,  1)  )), 
assert  (  (  label (Name,  none,  block (1) )  )). 
scanOldBlock (_) . 

scanJump (Type ,  Label) 

scanOldName (block.  Block), 

assert  ((  jump (Block,  Type,  Label)  )),  I. 

scanRecursion  (c  (p  (ProcName,  ProcAritv)  ,  _)  ,  Goal) 
functor  (Goal,  ProcName,  ProcArity)  . 

scar.Tag  (ClauseHead,  Tag) 

argil,  ClauseHead,  Tag),  '. 
scanTag(_,  none)  . 


%* 

%*  utilities 
%* 


%  gensym  with  general  root  (not  simply  symbol)  and  functor 
scanNewName (Functor ,  Root,  Name) 

scanlndex (Root,  Oldlndex) ,  !, 

retract (  (  scanlndex (Root ,  Oldlndex)  )), 

Newlndex  is  Oldlndex  +  1, 
assert ( (  scanlndex (Root,  Newlndex)  )), 

Name  =  ..  [Functor,  Root,  Newlndex]. 
scanNewName (Functor,  Root,  Name) 

assert  (  (  scanlndex (Root,  1)  )), 

Name  =  ..  (Functor,  Root,  1],  !. 

|  scanOldName (Functor,  Root,  Name) 

scanlndex (Functor,  Root,  Index), 

Name  =  ..  (Functor,  Root,  Index],  f. 

%  gensym  with  general  root  (not  simply  symbol) 
scanNewName (Functor,  Name) 

scanlndex (Functor ,  Oldlndex),  !, 
retract ((  scanlndex (Functor,  Oldlndex)  )), 

Newlndex  is  Oldlndex  +  1, 
assert  (  (  scanlndex (Functor,  Newlndex)  )), 

Name  =  ..  (Functor,  Newlndex]. 
scanNewName (Functor,  Name) 

assert  (  (  scanlndex  (Functor,  1)  )), 

Name  =. .  (Functor,  1],  !. 

scanOldName (Functor,  Name) 

scanlndex (Functor,  Index),  !, 

Name  =..  [Functor,  Index]. 
scanOldName (Functor,  Name) 

(show  ->  write ('...  Undefined  name  '),  write (Functor) ,  nl  ;  true) 
scanPass (Pass) ,  assert  (  (  scanError (Pass,  name)  )), 
assert  (  (  scanlndex  (Functor,  1)  )), 

Name  =..  [Functor,  1],  '. 

scanlnitialize 

flush (scanlndex,  2), 
flush (transferSrc,  2), 
f lush (transferExp,  4), 
flush (transferDst,  2), 
flush (transfer,  6), 
flush ( label,  3) , 
f lush ( jump,  3) , 
flush (scanUpdatePost,  2), 
f lush (scanError ,  2)  . 
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scanList  :  - 

1 i sting ( scan Index) , 
listing (transferSrc) , 
listing (transferExp) , 
listing(transferDst)  , 
listing (transfer) , 
listing (label) , 
listing ( jump) , 
listing (scanUpdatePost) , 
listing (scanError) . 

scanWrite (File) 

tell  (File)  , 
scanList, 
close (File) . 


%**  RTL  Scheduler 

%**  Schedule  abstract  transfers  and  produce  dependency  inrormation 

%**  data  base  items 
%*  (input:  label,  transfer) 

%*  cycle (<rtl-ID>, <block>, <cycle>) 

%*  schedDep (<resource>, <successor-ID>, <predecessor-ID>) 

%*  lastUse (<resource>, <last-user-ID>) 

%*  main  routine 
sched 

schedlnitialize, 
schedBlocks . 

%*  process  all  blocks  (each  has  one  label) 
schedBlocks 

label (_,  _,  Block), 

(show  ->  write (Block)  ;  true), 
schedBlock (Block) , 
fail . 

schedBlocks . 

%*  process  all  transfers  in  a  block 
schedBlock (Block) 

transfer(ID,  Block,  Srcl,  Src2,  OpType,  Dst), 

(show  ->  tab(l),  write (ID)  ;  true), 

schedTransfer (ID,  Srcl,  Src2,  OpType,  Dst,  Block), 

fail. 

schedBlock (Block) 

flush (lastUse,  2), 

(show  ->  nl  ;  true),  !. 

schedTransfer ( ID,  Srcl,  Src2,  OpType,  Dst,  Block) 
schedResource ( ID,  Srcl,  0,  CycleMl), 
schedResource ( ID,  Src2,  CycleMl,  CycleM2), 
schedResource ( ID,  Dst,  CycleM2,  MaxOldCycle) , 

NewCycle  is  MaxOldCycle  +  1, 

assert  (  (  cycle (ID,  51ock,  NewCycle)  )),  !. 
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%*  resource:  none 

schedResource ( ID,  none.  Cycle,  Cycle). 

%« 

%*  resource:  integer 

%*  this  assumes  it  is  always  available; 

%*  it  may  be  in  a  constant  ROM  for  which  there  is  contention 

schedResource ( ID,  constant (_) ,  Cycle,  Cycle). 

%* 

%*  resource:  field 

**  this  assumes  that  two  fields  cannot  be  accessed  at  once 

%*  remember  fields  in  lastUse  and  check  for  overlap 

schedResource (ID,  f ield  (Resource ,  _) ,  InCycle,  OutCycle)  :- 
schedResource (ID,  Resource,  InCycle,  OutCycle),  i. 

%* 

%*  resource:  general 

schedResource ( ID,  Resource,  InCycle,  OutCycle!  :- 
%  transfer  of  last  occurrence 
lastUse (Resource,  LastTransfer) , 

%  cycle  of  last  occurrence 
cycle (LastTransfer,  LastCycle) ,  !, 

schedMax  (InCycle,  LastCycle,  OutCycle), 
retract  ((  lastUse (Resource,  LastTransfer)  )), 
assert  (  (  lastUse (Resource,  ID)  )), 

assert  (  (  schedDep (Resource,  ID,  LastTransfer)  )). 

%* 

%*  resource:  general,  first  occurrence 
schedResource (ID,  Resource,  Cycle,  Cycle)  :- 
assert  (  (  lastUse (Resource,  ID)  )). 


%* 

%*  utilities 

%* 


schedlnitialize  :- 

flush (cycle,  3), 
flush (schedDep,  3), 
flush (lastUse,  2),  ! 

schedList  :- 

listing (cycle) , 
listing (schedDep)  . 

schedWrite (File)  :- 
tell  (File)  , 
schedList, 
close (File) . 

schedMax  (X,  Y,  X)  :-  X  >  Y. 

schedMax  (X,  Y,  Y)  . 


%**  Branch  generator 

%**  Generate  state  transitions,  removing  extra  cycles 

%**  data  base  items 

%*  (input:  label,  jump,  transfer,  cycle) 

%*  goto (<f rom-block>, <cycle>, <condit ion>, <to-block>) 

%*  unreachable (<block>) 

%*  main  routine 
branch  :- 

branch In  it ialize, 
branchBlocks, 
branchDeadBlocks . 
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%*  process  all  blocks  (each  has  one  label) 
branchBlocks 

label (_,  Block), 
jump(Block,  Type,  Target), 

(show  ->  tab(2),  write  (Block)  ,  tab(l),  write(Type),  nl  ;  true), 
branchBlock (Block,  Type,  Target), 
fail . 
branchBlocks . 

%*  process  an  unconditional  jump 
branchBlock (FromBlock,  jrst,  Target) 

branchTarget  (Target,  ToBlcrck)  , 
branchCycle (FromBlock,  0,  Cycle), 

assert ( (  goto (FromBlock,  Cycle,  true,  ToBlock)  )),  ! . 

%*  process  a  conditional  jump 
branchBlock (FromBlock,  cond,  FailTarget) 

transfer(_,  FromBlock,  Srcl,  Src2,  Cp,  control), 

FromBlock  =  block  (Oldlndex)  , 

Newlndex  is  Oldlndex  +  1, 

SuccessBlock  =  block (Newlndex) , 

%  (we  could  check  for  a  null  SuccessBlock  target) 
branchCycle (FromBlock,  0,  Cycle), 

assert  (  (  goto (FromBlock,  Cycle,  cond (Op,  Srcl,  Src2),  SuccessBlock)  )), 
branchTarget (FailTarget,  FailBlock) , 

assert  (  (  goto  (FromBlock,  Cycle,  cond(not(Op,  Srcl,  Src2)), 

FailBlock)  ) ) ,  ! . 

%*  process  a  case 

branchBlock (FromBlock,  case.  Target) 

transfer (_,  FromBlock,  Value,  none,  case,  control), 

%  (this  assumes  only  one  value  in  one  transfer  is  used  for  dispatch) 
branchCases (FromBlock,  Value,  Target),  !. 

%*  process  all  case  arm  labels 
branchCases (FromBlock,  Value,  ToProc) 

label (c (ToProc,  _) ,  Tag,  ToBlock), 
branchCaseArm (FromBlock,  Value,  Tag,  ToBlock), 
fail . 

branchCases (_,  _,  _) . 

%*  process  each  case  arm  label 
branchCaseArm (_,  _,  none,  _) 

%  ignore  untagged  case  arms 
branchCaseArm (FromBlock,  Value,  Tag,  To3iock) 
branchCycle (FromBlock,  0,  Cycle), 

assert ( (  goto (FromBlock,  Cycle,  case (Value,  Tag),  ToBlock)  )),  !. 

%*  non-null  block 
branchTarget (Target ,  ToBlock) 

label (Target,  none,  ToBlock), 
transfer (_,  ToBlock,  _,  _,  _,  _) ,  !. 

%*  null  block  --  follow  jump 
branchTarget (Targetl,  ToBlock) 

label (Target  1,  none,  IndirectBlock) , 
jump ( IndirectBlock,  jrst,  Target2) , 
branchTarget (Target2 ,  ToBlock),  !. 

%*  find  last  cycle  in  a  block 

branchCycle (Block,  PreviousCycle,  FinalCycle) 

ThisCycle  is  PreviousCycle  +  1, 
cycle (_,  Block,  ThisCycle),  !, 
branchCycle (Block,  ThisCycle,  FinalCycle), 
branchCycle (_,  Cycle,  Cycle). 

%*  check  all  blocks  for  unreachable  ones 
branchOeadBlocks 

label (_,  _,  Block) , 
branchDeadBlock  (Block) , 
fail. 

branchOeadBlocks . 
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%*  "ar<  ar.  unreachaole  blcc< 
brancr.Dead3iock  (31cck) 

goto(_,  Block!,  !. 

branchDeadBlock (Block)  : - 

(show  ->  tab(2),  write  (Block)  ,  write!'  is  unreachable'),  nl 
assert  (  (  unreachable (Block)  )),  (. 

%* 

%*  utilities 

%* 

branchlnitiaiize 

flush (goto,  A )  , 

flush (unreachable ,  1),  !. 


branchList 

listing (goto) , 
listing  (unreacr.aoie ) 


branchWrite (Fi le) 

tell (File) , 
branchList , 
close (File) 


%** 


%** 


Data  Path  Allocator 

Allocate  data  path  elements 


%** 

%* 

%* 

%* 

%* 

»* 

%* 

%* 

%* 

%* 

%* 

%* 


%* 

%* 


data  base  items 

library  input 

libOperator (Op,  Fn,  Class) 
libUnit (Type) 

libFunction (Type,  Function) 

RTL  input 

transfer,  label,  cycle 

intermediate  results 

allocCombFn (Class,  Fn,  Arg)  . 

(functions  needed  --  unique  triples) 
ailocCombPar (31 uck.  Cycle,  Fn,  Arg). 
(concurrent  resource  use) 


%*  output 

%*  unit (Unit,  Type) 

%*  functionBinding (Unit,  Function) 

%'  funct ionUse  ( ID,  Block,  Cycle,  Fn,  Arg). 

%*  argRebinding (ID,  Src,  Dst). 

%*  main  routine 
alloc 


alloc Initialize, 
allocScanBlocks, 
allocUnits . 


%*  process  all  blocks  (each  has  one  label)  —  determine  needs 
allocScanBlocks 

label (_,  _,  Block), 

(show  ->  write (Block)  ;  true), 
allocScanBlock (Block) , 
fail . 

allocScanBlocks  . 


process  all  transfers  in  a  block 
allocScanBlock (Block) 

transferdD,  Block,  Srcl,  Src2,  Op,  Dst), 
(show  ->  tab(l),  write(ID)  ;  true), 
al locScanTransfer (ID,  Srcl,  Src2,  Op,  Dst), 
fail . 


true) 
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* . locScar.BIock  (_)  : - 

(show  ->  nl  ;  cruel,  . 

%  transfer:  move 

allocScanTransfer (ID,  Src,  none,  move,  Dsc)  : , 

aliocReg (Sro)  , 
ailocReg (Dst)  ,  I  . 

%  transfer:  special  case  --  increment 

ai  iocScanTransf  er  ( ID ,  Counter,  cor.stant(I),  '  »'  ,  Counter)  !, 
aliocReg (Counter) , 

aliocAssertComoFn (ID,  count,  ir.c.  Counter), 

%  transfer:  special  case  --  shift  one 

allocScanTransfer (ID,  Src,  constant(i),  ' >>' ,  Dst)  :-  !, 

ailocReg (Src) , 
a  1 locReg (Dst ) , 

allocAssertCombFn (ID,  shift,  shrl,  none),  !. 

%  transfer:  special  case  —  less  than  zero  test 
allocScanTransfer (ID,  Reg,  constant (01 ,  '<',  controll  :-  !, 
al locReg (Reg) , 

al locAssertCombFn (ID,  control,  ltzero,  Reg),  !. 

%  transfer:  special  case  --  case  test 

allocScanTransfer (ID,  Reg,  none,  case,  control)  :-  :, 
aliocReg (Reg) , 

allocAssertCombFn (ID,  control,  case,  Reg),  !. 

%  one  operand  functions 

allocScanTransfer (ID,  Src,  none.  Op,  Dst)  :-  !, 
aliocReg (Src) , 
al locReg (Dst ) , 

1 ibOperator (Op,  Fn,  Class), 

allocAssertCombFn  (ID,  Class,  Fn,  none),  . 

%  two  operand  functions 

ai  locScanTransfer  ( ID,  Srcl,  Src2,  Op,  Dst)  :-  , 

al  locReg  (Srcl)  , 
aliocReg (Src2) , 
al locReg (Dst ) , 
libOperator (Op,  Fn,  Class), 
allocAssertCombFn (ID,  Class,  Fn,  none),  !. 

%  note  combinat ionai  functions 
allocAssertCombFn (ID,  Class,  Fn,  Arg)  :- 
a  1 locCombFn (Class,  Fn,  Arg),  !, 
a  1 iocAssertCombUse ( ID,  Fn,  Arg). 
allocAssertCombFn ( ID,  Class,  Fn,  Arg)  :- 

assert  (  (  allocCombFn (Class,  Fn,  Arg)  )), 
a llocAssertCombUse ( ID,  Fn,  Arg),  !. 
allocAssertFnList (FU,  Tail). 

%  note  cycles  with  parallelism 
ailocAssertCombUse ( ID,  Fn,  Arg)  :- 
cycle (ID,  Block,  Cycle), 

functionUse (_,  Block,  Cycle,  Fn,  Arg),  !, 

(show  ->  write ('...  concurrency  in  ' ) ,  write (Block ) , 
wnte(-),  write  (Cycle)  ,  write!'  with  '), 
write(Fn),  write(-),  write(Arg),  nl 

true 
)  , 

assert  (  (  allocCombPar (3iock,  Cycle,  Fn,  Arg)  )), 
assert  (  (  funct ionUse ( ID,  Block,  Cycle,  Fn,  Arg)  )). 
ailocAssertCombUse (ID,  Fn,  Arg)  :- 
cycle (ID,  Block,  Cycle), 

assert  (  (  funct ionUse ( ID,  Block,  Cycie,  Fn,  Arg)  )),  !. 

aliocReg (none)  :- 

al locReg (constant (Constant ) )  :- 

(show  ->  write(’...  constant  register  '),  wr  i  te (Const  ant ) ,  nl 

t  rue 

)  ,  !  . 
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aiiocReg (field (Reg,  Field)' 
aiiocReg (Reg) ,  ! . 

aiiocReg (Reg) 

unit  (Reg,  reg)  ,  . 

aiiocReg (Reg)  :- 

assert  (  (  unit (Reg,  reg)  ) ) ,  ! . 

%» 

%’  allocate  functional  units 

%* 

aliocUnits 

a 1 locAr ithLogica is, 
allocShifts, 
allocControls, 
ail ocMemF  ns . 

%*  allocate  ail  arithmetic-logical  units 
al locArithLogicais 

setof (X,  T " (al locCombFn Sarlog,  X,  T)  )  ,  3), 
al locAr ithLogica I (S '  ,  ! . 

a 1 locArithLogicais . 

%  special  case:  no  arlog 
a 1 locAr ithLogica 1 ( ( ] )  . 

%  special  case:  add  only 
allocArithLogical ( [add] )  :- 

1  ibUnit  (adder)  ,  !, 

allocUnitName (adder.  Unit), 
assert  (  (  funct  ionBindi.ng  (Unit ,  add)  )), 

(allocCombFn (count,  inc,  _!  -> 

assert  (  (  functionBindir.g  (Unit,  inc)  ))  ), 
al lccRebindOneArg (inc)  . 

%  general  case:  ALU 
allocArithLogical (S I  :- 
libUnit (alu) ,  ! , 
allocUnitName (alu,  Unit), 
allocUnitFns (Unit,  S)  , 
alloclncrement (Unit)  . 

%  error 

allocArithLogical (S)  :- 

(show  ->  writer...  unable  to  implement  ALU 

true 

)  . 

%  special  case:  increment  register 
alloclncrement (ALU)  :- 

%  (do  for  all  allocCombFn' s  and  schedule  to  disambiguate) 
allocCombFn (count,  inc.  Counter), 

1 ibUnit ( increg) ,  !, 

functionUse (ID,  Block,  Cycle,  inc.  Counter), 
assert ( (  functionBinding (Counter,  inc)  )), 
allc-RebindNoArgs (ID) . 

%  special  case:  increment  ALU 
alloclncrement (ALU)  :- 

%  (do  for  all  allocCombFn' s  and  schedule  to  disambiguate) 
allocCombFn (count,  inc.  Counter),  ! , 
assert ( (  funct ionBinding (ALU,  inc)  )), 
allocRebindOneArg (inc) . 

%  general  case:  no  increment 
alloclncrement (  ) . 


unctions  '  )  ,  wr it< 


allocUnitFns (_,  f ] ) . 

allocUnitFns (Unit,  [Function  I  Tail]) 
unit (Unit,  Type) , 

1 ibFunct ion (Type,  Function),  ! 
assert  (  (  funct ionBinding (Unit, 
allocUnitFns (Unit,  Tail). 


Function)  ) ) , 


(S),  nl 
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allocUnitFns  (Unit ,  [Function  I  Tail]) 

(show  ->  write!'...  function  '),  write  (Function) ,  write  ('  in  ' 
write  (Unit),  write)'  is  unsupported'),  nl 

true 
)  , 

allocUnitFns  (Unit,  Tail). 
allocShifts 

setof (X,  T* (allocCombFn (shift,  X,  T) ) ,  S) , 
allocShift  (S) ,  !  . 

allocShifts . 

%  special  case  shift  right  one 
allocShift ( [shrl] ) 

libFunction (alu,  shrl), 
unit (ALU,  alu) ,  ’ , 

%  assumes  no  conflict  between  shift  and  alu  operations 
assert  (  (  funct ionBinding (ALU,  shrl)  )), 
allocRebindOneArg (shrl) . 
allocShift (  [shrl] ) 

libUnit  (shfone) ,  !, 

allocUnitName (shfone,  Unit), 
assert  (  (  funct ionBinding (Unit ,  shrl)  )), 
allocRebindOneArg (shrl) . 
allocShift  (S)  :  - 

(show  ->  write ('...  unable  to  implement  shift  functions  '), 
write (S) ,  nl 

t  rue 
)  . 

allocControis 

setof (X,  T* (allocCombFn (control,  X,  T) ) ,  S) , 
allocControl  (S) ,  !. 

allocControis . 

allocControl ( [ ] ) . 
allocControl ( [case  i  Tail]) 

%  (do  for  all  such  al locCombFn' s) 
allocCombFn (control,  case,  Reg), 
assert  (  (  funct ionBina ing (Reg,  case)  )), 
allocControl  (Tail) ,  !  . 

allocControl ([ ltzero  i  Tail]) 

%  (do  for  all  such  allocCombFn' s) 
allocCombFn (control,  ltzero,  Reg), 
assert  ((  functionBinding (Reg,  ltzero)  )), 
allocControl (Tail) ,  !• 

allocControl ( [C  I  Tail]) 

(show  ->  write ('...  unknown  control  function  '),  write (C),  nl 
allocControl (Tail) ,  !. 

allocMemFns 

setof (X,  T* (allocCombFn (mem,  X,  T) ) ,  5), 
al locMemFn (S) ,  ! . 

allocMemFns. 

allocMemFn ( [ ] ) . 

allocMemFn ( [mem_read  I  Tail]) 

assert (  (  functions4 nding (mem,  mem_read)  )), 
allocMemFn (Tail) . 
allocMemFn  (  [mem_write  1  J) 

assert  (  (  funct, -.nt  dinglmem,  mem_write)  )), 
allocMemFn (Ta) ) , ,  I. 
allocMemFn ( [M  I  Tail)) 

(show  ->  write  ('  .  iown  memory  function  '),  write  (M),  nl  ; 

al locMemFn (Tz  1),  '. 


;  true) , 


true)  , 
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allocUnitName (Type,  Name)  : - 

allocUnitlndex (Type,  1,  Newlndex), 

Name  =..  [Type,  Newlndex], 
assert  (  (  unit (Name,  Type)  ) )  ,  1 . 

allocUnit Index (Type,  Thislndex,  Lastlndex) 

Name  =..  [Type,  Thislndex] , 
unit (Name,  Type),  !, 

Nextlndex  is  Thislndex  +  1, 

allocUnitlndex (Type,  Nextlndex,  Lastlndex). 

allocUnitlndex (_,  Index,  Index). 

allocRebindOneArg (Fn) 

%  (do  for  all  funct ionUse' s ) 

functionUse ( ID,  _,  _,  Fn,  _)  , 

transfer(ID,  _,  Src,  _,  _,  Dst), 

assert  (  (  argRebinding ( ID,  Src,  Dst)  )),  !. 

allocRebindOneArg (Fn) 

(show  ->  write!'...  rebind  error  for  '),  write(ID),  nl  ;  true). 

allocRebindNoArgs (ID) 

assert  (  (  argRebinding ( ID,  none,  none)  )). 

%* 

%*  utilities 

%* 

alloclnitialize 

flush (unit,  2)  , 
flush (functionBinding,  2), 
flush (functionUse,  5), 
flush (argRebinding,  3), 
flush (allocCombFn,  3), 
flush (allocCombPar,  4),  !. 

allocList 

listing (unit) , 

1 isting ( functionBinding) , 

1 i st ing ( funct ionUse) , 
listing (argRebinding) , 
listing (allocCombFn) , 
listing (allocCombPar) ,  !. 

allocWrite (File) 

tell  (File)  , 
allocList, 
close  (File)  . 


%**  Data  Path  Connecter  and  Scheduler 

%**  Connect  and  schedule  functional  units 

data  base  items: 

%* 

%*  input:  transfer,  label,  cycle,  libTwoPorts, 

%*  unit,  functionBinding,  functionUse,  argRebinding 

%* 

%*  busSrc(Bus,  Resource) 

%*  busDst (Bus,  Resource) 

%* 

%*  bus (Bus) 

%*  do (Unit,  Fn,  Block,  Cycle,  ID) 

%*  move(Bus,  Src,  Dst,  Block,  Cycle,  ID) 

%*  main  routine 
conn  :- 

connln it ial ize, 
connBlocks . 
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%*  process  all  blocks 
connBlocks 

label (_,  Block) , 

(show  ->  write (Block)  ;  true), 
connBlock (Block) , 
fail . 

connBlocks . 

%*  process  all  transfers  in  a  block 
-o"nBlock (Block) 

transferdD,  Block,  Srcl,  Src2,  OpType,  Dst) , 
(show  ->  tab(l),  write(ID)  ;  true), 
connTransfer  (ID,  Srcl,  Src2,  OpType,  Dst), 
fail . 

connBlock (Block) 

(show  ->  nl  ;  true) ,  !  . 

%  transfer:  move 

connTransfer (ID,  Src,  none,  move,  Dst) 
connSchedBus (ID,  Src,  Dst),  !. 

% 

%  transfer:  memory 

connTransfer (ID,  _,  _,  mem_read,  _)  :- 

connSchedUnit (ID,  Unit),  !. 
connTransfer (ID,  _,  _,  mem_write,  _)  :- 

connSchedUnit  (ID,  Unit),  . 

% 

%  transfer:  control  (passive) 
connTransfer ( ID,  _,  _,  _,  control)  :-  !. 

% 

%  transfer:  rebound,  no  arguments 
connTransfer (ID,  _,  _,  _,  _)  :- 

argRebinding (ID,  none,  none),  !, 
connSchedUnit (ID,  Unit). 

% 

%  transfer:  rebound,  one  argument  and  one  destination 
connTransfer (ID,  _,  _,  _,  _) 

argRebinding(ID,  Src,  Dst),  !, 
connSchedUnit (ID,  Unit), 
connSchedBus (ID,  Src,  Unit), 
connSchedBus (ID,  Unit,  Dst). 

% 

%  transfer:  one  operand  function 
connTransfer (ID,  Src,  none,  _,  Dst)  :- 
connSchedUnit ( ID,  Unit), 
connSchedBus (ID,  Src,  Unit), 
connSchedBus (ID,  Unit,  Dst),  !. 

% 

%  transfer:  two  operand  function 
connTransfer ( ID,  Srcl,  Src2,  _,  Dst) 
connSchedUnit (ID,  Unit), 
connSchedBus (ID,  Srcl,  Src2,  Unit), 
connSchedBus (ID,  Unit,  Dst),  !. 

%  already  scheduled  (by  alloc) 
connSchedUnit ( ID,  Unit)  :- 

do (Unit,  _,  _,  _,  ID),  !. 

%  schedule  from  alloc  information 
connSchedUnit (ID,  Unit) 

functionBinding (Unit,  Fn) , 

functionUse (ID,  Block,  Cycle,  Fn,  Arg) , 

assert  (  (  do(Unit,  Fn,  Block,  Cycle,  ID)  )),  !. 

connSchedBus (ID,  Src,  Dst)  :- 

cycle (ID,  Block,  Cycle), 

connGetFreeBus (Block,  Cycle,  Src,  Dst,  Bus), 
assert  (  (  movelBus,  Src,  Dst,  Block,  Cycle,  ID) 
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connSchedBus ( ID ,  Src..,  Src2,  Unit) 

connPortName (Unit,  I,  Dstl), 
conr.SchedBus  (ID,  Srcl,  Dstl), 
connPortName (Unit ,  2,  Dst2), 
connSchedBus (ID,  Src2,  Dst2)  . 


connGetFreeBus (Block,  Cycle 
%  bus  connects  and 
busSrc  (Bus,  Src)  , 
busDst (Bus,  Dst), 

\  +  (move  (Bus,  _,  _ 
connGetFreeBus (Block,  Cycle 
%  bus  connects  to  s 
busSrc (Bus,  Src), 

\+  (busDst  (Bus,  Dst 
\+  (move (Bus,  _,  _, 
assert ( (  busDst (Bus 
connGetFreeBus (Block,  Cycle 
%  bus  connects  to  d 
\+  (busSrc (Bus,  Src 
busDst (Bus,  Dst), 

\+  (move (Bus,  _,  _, 
assert ( (  busSrc (Bus 
connGetFreeBus (Block,  Cycle 
%  bus  is  available 
bus (Index) , 

\+  (move  (bus  (Index) 
assert ( (  busSrc (bus 
assert ( (  busDst (bus 
connGetFreeBus (Block,  Cycle 
%  create  new  bus 
connBusName (Bus) , 
assert ( (  busSrc (Bus 
assert ( (  busDst (Bus 


Src, 
is  avai 


Dst,  Bus!  : - 
able 


Block, 
Src, 
rc  and 


Cycle,  _) ) , 
Dst,  Bus) 
is  available 


)  )  , 

Block, 
,  Dst) 
Src, 
st  and 
)  )  , 


Cycle,  _) ) , 
)  )  . 

Dst,  Bus) 
is  available 


Block, 

Src) 

Src, 


Cycle,  _) ) ,  ! , 

)  )  . 

Dst,  bus (Index)) 


( Index) 
( Index) 
,  Src, 


Block,  Cycle,  _) 
,  Src)  )), 

,  Dst)  ) ) . 

Dst,  Bus) 


Src) 

Dst) 


)  )  , 
)  )  , 


connPortName (Unit,  Index,  port (Unit,  Index)) 


connBusName (bus (Newlndex) ) 

connBusIndex (1,  Newlndex), 
assert  (  (  bus  (Newlndex)  )  )  , 


connBusIndex (Thislndex,  Lastlndex) 
ous (Thislndex) ,  ! , 

Nextlndex  is  Thislndex  +  1, 
connBusIndex (Nextlndex,  Lastlndex) 
connBusIndex ( Index,  Index). 


%* 


%*  utilities 

%* 


connlnitialize 

flush (connlndex, 
flush (bus,  1) , 
flush  (do,  5)  , 
flush (move,  6) , 
flush (busSrc,  2) , 
flush (busDst,  2) , 


2)  , 


connList 


listing (bus) , 
listing (do) , 
listing (move) , 
listing (busSrc) , 
listing (busDst ) , 


connWrite (File) 

tell  (File)  , 
connList, 
close (F ile)  . 
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%**  Liorary 

IibOperator  {'+' ,  add,  arlog)  . 
iioOperatoi  ('  ,  sub,  arlog)  . 

IibOperator  ('  A' ,  and,  arlog). 
IibOperator  (' \/' ,  or,  arlog). 
IibOperator  ('  V  ,  corap,  arlog). 
IibOperator  ('>>' ,  shr,  shift). 
IibOperator  ('<<'  ,  shl,  shift). 
IibOperator (mem_read,  mem_read,  mem). 
IibOperator (mem_write,  mem_write,  mem). 

libUnit ( increg) . %  incremented  register 
libUnit (adder) .  %  adder 

libUnit (alu) .  %  ALU 

libUnit (shfone)  .  %  shifter 

libFunction (increg,  inc) . 
libFunction (adder,  add). 
libFunction (adder,  inc). 
libFunction (alu,  add). 
libFunction  (alu,  inc). 
libFunction (alu,  and). 

%libFunction  (alu,  or). 

%libFunction (alu,  shrl)  . 

% libFunction (alu,  shll)  . 
libFunction (shfone,  shrl). 

%libFunction (shfone,  shll). 

libTwoPorts (adder) . 
libTwoPorts (alu) . 
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%  symbolic  SMI 

stateRegister (ac,  16). 
scateRegister (pc,  16). 
stateRegister (memAR,  16). 
scateRegister (memDR,  16). 
stateField (memDR,  inst,  opcode,  1). 
stateField (memDR,  inst,  address,  2). 


write  ('  —  fetch  '  )  ,  stateCount  (Cl)  ,  write  (Cl)  ,nl, 
fetch,  ! , 

write (' — update  '  )  ,  stateCount (C2) , write (C2) , nl, 
stateUpdate,  !, 

write ( ' — access' ) , nl, 
access (memDR,  opcode,  OP),  !, 

write  ('  --execute  ' )  ,  write  (OP)  ,  nl, 

! ,  execute (OP ) ,  ! , 

write (' — update  ' ) , stateCount (C3) , write (C3) , nl, 
stateUpdate,  !, 

write (' — recurse' ) , nl. 


run . 

run  :-  true. 


fetch  :- 

access  (pc, 
mem_read, 
access  (pc. 


PC)  , 
PC)  , 


set (memAR,  PC), 

PI  is  PC-t-1,  set  (pc,  PI). 


execute (halt )  :-  !, 

fail . 

execute (add)  :-  !, 

access (memDR,  address,  X),  set (memAR,  X), 
mem_read, 

access (memDR,  T) ,  accessfac,  AC),  A  is  T+AC, 
execute  (and)  !, 

access (memDR,  address,  X),  set (memAR,  X), 
mem_read, 

access (memDR,  T) ,  access (ac,  AC),  A  is  T/\AC, 
execute  (shr)  :-  !, 

access (ac,  AC),  A  is  AC>>1,  set (ac,  A), 
execute ( load)  :-  !, 

access (memDR,  address,  X),  set (memAR,  X), 
mem_read, 

access (memDR,  T) ,  set (ac,  T)  . 
execute (stor)  :-  !, 

access (memDR,  address,  X),  set (memAR,  X), 
access  (ac,  T)  ,  set  (memDR,  T)  , 
mem_write . 
execute ( jump)  :-  !, 


access  (memDR, 

address. 

T)  , 

set (pc, 

T) 

execute (brn)  :- 

access (ac,  AC) 

,  AC<0, 

» 

•  t 

access (memDR, 

address. 

T)  , 

set (pc. 

T) 

execute(brn)  :- 
true . 


set (ac,  A)  . 


set (ac.  A) . 
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*  /* 

set-up . inverter :  bench  set-up  for  (asp/ccmpactor)  inverter 
V 

inverter  :-  driver  (  inverter)  . 

benchmark ( inverter, 

compact  ( '  examples/ out /inverter'  )  , 
dummy ( ' examples /out / inverter' ) , 

1)  :  - 

consult  ('  examples  /  in  /  inverter .  sip' )  . 

show (inverter)  :-  reconsult (' examples/ in/inverter . sip' ) , 
assert ( show) , 

compact ( ' examples /out/ inverter' ) , 
retract (show) . 


♦include  "driver" 
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set-up . random_logic:  bench  set-up  for  (asp/compactor)  random_log 

*/ 

random_logic  :-  driver (random_logic) . 

benchmark (random_logic, 

compact  ('  examples/out/rar.dom_logic' ) , 
dummy (' examples/out/random_logic'  ) , 

1)  :  - 

consult ('examples/in/random_logic.sip' ) . 

show (random_logic)  :-  reconsult (' examp les/ in / random_logic . sip' ) , 
assert (show) , 

compact (' examples/out /random_logic' ) , 
retract ( show) . 


#include  "driver 


sml .bench 


*  /* 

set-up. sml:  bench  set-up  for  (asp/ viper)  sml 
*/ 

sml  :-  driver(sml). 

benchmark (sml,  viper (' examples/out/sml' ) ,  dummy  (' examples/out/sml' )  ,  10) 
re consult (' examples/ in/ sml'  )  . 

show (viper)  :-  reconsult ('examples/in/sml'  ) , 
assert ( show) , 

viper  (' examples/out/sml' )  . 
retact  ( show)  . 


((include  "driver" 
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*  /* 

adder. m:  benchmark  (circuit)  adder  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  opt  ion ( s )  :  $ _ OPTIONS _ S 

% 

%  (circuit)  adder 
% 

%  Alvin  M.  Despain  (despain@cse.usc.edu) 

% 

%  September  1986 
% 

%  design  a  (full)  adder  using  2-input  NAND  gates 

((assign  ADDER_SPEC  (0,0,0,1,0,1,1,11 

* 

#  if  BENCH 

#  include  ". adder .bench" 

*else 

((option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  thac  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 
ft  if  SHOW 

adder  circuit (ADDER_SPEC,  Solution), 

write  (adder)  ,  write(':  '),  write  (Solution)  ,  nl. 

#  else 

adder  circuit (ADDER_SPEC,  _) . 

(f  endif 
#endif 

♦include  "circuit"  /*  code  for  circuit  design  */ 
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♦  /* 

mux.m:  benchmark  (circuit)  mux  master  file 

*/ 

%  generated:  MDAY _  _ MONTH _  _ _ YEAR _ 

%  option ( s) :  $^_OPTIONS _ S 

% 

%  (circuit)  mux 
% 

%  Alvin  M.  Despain  (despain@cse.usc.edu) 

% 

%  September  1986 
% 

%  design  a  2-1  mux  using  2-input  NAND  gates 

♦  assign  MUX_SPEC  10,1,0,1,0,0,1,1] 

* 

♦if  BENCH 

♦  include  " .mux. bench" 

♦else 

♦option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

♦  if  SHOW 

mux  circuit (MUX_SPEC,  Solution), 

write  (mux)  ,  writer  :  '),  write  (Solution)  ,  nl. 

♦  else 

mux  circuit (MUX_SPEC,  _) . 

♦  endif 
♦endif 

♦include  "circuit"  /*  code  for  circuit  design  */ 
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circuit:  code  for  circuit  design 

*/ 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (circuit/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  rur 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.” 
♦if  DUMMY 

circuit (_,  _) . 

♦  else 

%  This  is  a  program  to  design  a  3-input  digital  circuit 
%  using  2-input  NAND  gates  given  the  truth  table  of  the 
%  desired  circuit.  For  example, 

% 

%  ?-  circui  t  (  i  0,  1 , 0,  1 ,  0 , 0 ,  1,  1 1 ,  Solution). 

% 

%  designs  a  2  to  1  MUX.  ( (0, 1, C, 1, 0, 0, 1, 1]  means  SAB  = 

%  000  <=>  out  =  0,  SAB  »  001  <=>  out  =  1,  et  cetera.) 

% 

%  The  strategy  is  breadth-first  search,  where  circuits 
%  at  level  N  of  the  search  tree  contain  N  gates. 

% 

%  (Clauses  of  signals/2  could  be  added  to  deal  with 
%  circuits  having  other  than  3  inputs.) 


circuit (Specif ication.  Solution)  : - 
num (Depth_limit ) , 

search (Depth_limit,  0,  Specification,  Solution),  !. 


search (_Deptn_l imit ,  _Depth,  Table,  Solution! 
signals (Solution,  Table). 

sea rch (Dept h_l imit ,  Depth,  Table,  nand (SI  1, S12) )  :  - 

Depth  <  Depth_limit, 

D  is  Depth  +  1, 

search (Depth_limit,  D,  Spl,  Sll), 

ngate  (Table,  Spl,  Sp2), 

search  (Depth_limit,  D,  3p2,  S12)  . 


%  Input  signals  are  free  and  terminate  the  search. 


signals*  0 
signals!  1 
signals!  2 
signals)  v 
signals ( iO 
s igna  Is  (  i  1 
signals  ( i2 


(0,  1,0,  1,0,  1,0,  1])  . 

[0, 0,  1,  1,  0,  0,  1,  1)  )  . 

[0,  0,  0,  0,  1,  1, 1,  1]  )  . 

11,1,1,1,1,1,1,1]).  %  Turn  a  NAND  gate  into  an  inverter. 

[1, 0,  1,  0,  1,  0,  1,  0]  )  . 

[1,  1, 0,  0,  1,  1, 0, 0]  )  . 

[1,  1,  1,  1,0, 0,0, 0]  )  . 


be  rice  ley  #3 


circuit 


%  Optimized  for  "side"  gate  signal  transformation, 
ngate ( t ] ,  U .  ()>■ 

ngate ( [1 ITO] ,  [0IT1],  [_ ! T2 ] )  :-ngate(T0,  Tl,  T2) 
ngate ( [1 1  TO] ,  [1IT1],  [ 0  I T2 ] )  :-ngate(T0,  Tl,  T2) 
ngate < [0 ITO] ,  [ 1 1 Tl ] ,  [ 1 1 T2 ] )  :-ngate(T0,  Tl,  T2) 


num(O)  . 

num(N)  num(M),  N  is  M  +  1. 
#endi f 
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♦  /* 

concat_i.m:  benchmark  (concat)  concat_i  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s)  :  S _ OPTIONS _ $ 

% 

%  (concat)  concat_l 

% 

%  (deterministically)  concatenate  !a,b,c]  and  [d,e] 

#if  BENCH 

♦  include  concat_l , bench" 

♦  else 

concat_l  concat ( (a, b, cl , (d, e] ,_) . 

♦endi f 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (concat/3) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.” 
# i f  DUMMY 

concat (_, _,_) . 

♦else 

concat  ( ( ] ,  L,  L)  . 

concat ( [X  I  LI] , L2,  (XI L3] )  concat (LI, L2, L3) . 

♦e  .dif 
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*  /* 

concat_6.m:  benchmark  (concat)  concat_6  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s):  $ _ OPTIONS _ S 

% 

%  (concat)  concat_6 
% 

%  (nondeterministically)  "deconcatenate”  [a,b,c,d,e]  (6  possibilities  exist) 

#if  BENCH 

$  include  " . concat_6 .bench" 

*else 

concat_6  run_concat_6 . 
ttendif 

#opt ion  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (run_concat_6/0) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.” 

#if  DUMMY 

run_concat_6 . 
jfelse 

run_concat_6  concat (_,_, (a, b, c,d,e] ) ,  fail. 
run_concat_6 . 

concat  ( [] ,  L,  L)  . 

concat  ( (XJL1]  ,L2,  (XJL3] )  concat  (LI,  L2,  L3)  . 
tendif 
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*  /* 

hanoi_8.m:  benchmark  (hanoi)  hanoi_8  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s) :  $ _ OPTIONS _ $ 

% 

%  (hanoi)  hanoi_8 

% 

%  solve  the  3-disk  towers  of  Hanoi  problem 
# if  BENCH 

#  include  " .hanoi_8 .bench" 
tfelse 

hanoi_8  hanoi(8). 

#endif 

#include  "hanoi"  /*  code  for  solving  the  N-disk  towers  of  Hanoi  */ 
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hanoi  16. m 


* 


% 

% 

% 

% 

% 

% 


/* 

hanoi_16.m:  benchmark  (hanoi)  hanoi_16  master 
*/ 

generated:  _ MDAY _ MONTH _ YEAR _ 

option (s) :  $ _ OPTIONS _ $ 

(hanoi)  hanoi_16 

solve  the  16-disk  towers  of  Hanoi  problem 


# if  3ENCH 

#  include 

♦  else 
hanoi_16 
#endif 


1  .hanoi_16. bench" 
hanoi (16) . 


file 


♦include 


"hanoi” 


/*  code  for  solving  the  N-disk  towers  of  Hanoi  */ 
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hand 


#  /* 

hanoi:  code  for  solving  the  N-disk  towers  of  Hanoi  problem 
*/ 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (hanoi/1)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.” 

#if  DUMMY 

hanoi  (_)  . 

♦else 

%  This  program  solves  trv  "owers  of  Hanoi  problem:  move  a  tower  of 

%  N  (punctured)  disks  of  various  diameters  from  one  peg  to  another 

%  with  the  help  of  an  auxiliary  peg  and  according  to  the  rules  (1) 

%  only  one  disk  can  be  moved  at  a  time  and  (2)  a  larger  disk  cannot 

%  be  put  on  top  of  a  smaller  disk.  The  algorithm  is  deterministic 

%  and  highly  recursive. 

% 

%  No  static  representation  of  the  solution  is  accumulated  by  this 
%  implementation  of  the  algorithm. 

hanoi (N)  move (N, a, b, c)  . 

move (0, _, _,_)  : -  !  . 

move (N,A,B,C)  M  is  N-l,  move (M, A, C, B) ,  move (M, C, B, A) . 

♦endif 
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mu  .m 


♦  /* 

mu.m:  benchmark  mu  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s) :  $ _ OPTIONS _ $ 

% 

%  mu 

% 

%  derived  from  Douglas  R.  Hofstadter,  "Godei,  Escher,  Bach, "  pages  33-35. 
* 

%  prove  "mu-math"  theorem  muiiu 
#if  BENCH 

♦  include  ".mu. bench" 

#else 

mu  :-  theorem (5,  [m, u, i, i,u] ) . 

♦endif 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (theorem/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 

#if  DUMMY 

theorem (_,  _) . 

♦else 

theorem (m,  i]). 
theorem (_,  [])  :- 

fail. 

theorem(Depth,  R)  :- 
Depth  >  0, 

D  is  Depth-1, 
theorem (D,  S) , 
rules (S,  R) . 


rules (S, 

R) 

:-  rulel  (S,  R) 

rules (S, 

R) 

: -  rule2 (S,  R) 

rules (S, 

R) 

rule3(S,  R) 

rules (S, 

R) 

:  -  rule4  (S,  R) 

rulel (S, 

R) 

append (X,  [i],  S) , 

appendtX,  [i,u] ,  R)  . 

rule2([m|T],  [mlR])  :- 
append  (T,  T,  R)  . 

rule3  ( ( ] ,  -)  :- 
fail. 

rule3 (R,  T)  :- 

append ( [i, i, i] ,  S,  R) , 
append ([u],  S,  T)  . 

rule3 ((HIT],  (H I R] )  :- 

rule3 (T,  R) . 

rule4  ( [ ] ,  -)  :- 
fail. 

rule4 (R,  T)  :- 

append ( [u, u] ,  T,  R) . 

rule4 ([HIT],  [ H I R 1 ) 

rule4  (T,  R)  . 
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mu  .m 


append ( [ ] ,  X, 
append ( [ A  I B] , 
append  (B, 
#endif 


X)  . 

X,  [  A  I  B1  ]  ) 
X,  Bl)  . 
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prime_100 .m 


*  n 


Drime  100. m:  benchmark  (prime)  prime_100  master  file 


*7 


YEAR 


%  generated:  _ MDAY _  _ MONTH _  _  _ 

%  option (s) :  $ _ OPTIONS _ $ 

% 

%  (prime)  prime_100 

% 

%  from  Clocksin  and  Mellish,  "Programming  in  Prolog"  (edition  1),  page  157. 
% 

%  find  every  prime  number  less  than  100 
#if  BENCH 

#  include  ” ,prime_100 . bench" 
lelse 

♦option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

#  if  SHOW 

prime  100  primes (100,  Ps) ,  write(Ps),  nl. 

#  else 

prime_100  primes(100,  _) . 

#  endif 
♦endif 


♦include  "prime" 


/*  code  to  find  every  prime  less  than  N  */ 
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prime_1000 .m 


#  /* 

pr ime_1000 .m:  benchmark  (prime)  prime_1000  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  opt  ion (s )  :  $ _ OPTIONS _ $ 

% 

%  (prime)  prime_1000 

t 

%  from  Clocksin  and  Mellish,  "Programming  in  Prolog"  (edition  1),  page  157. 

% 

%  find  every  prime  number  less  than  1000 
#if  BENCH 

#  include  " ,prime_1000 .bench" 

♦else 

♦option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/l.“ 
t  if  SHOW 

prime_1000  primes (1000,  Ps) ,  write  (Ps),  nl. 

#  else 

prime_1000  primes(1000,  _) . 

#  endif 
#endif 

♦include  "prime"  /*  code  to  find  every  prime  less  than  N  */ 
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prime 


♦  /* 

prime:  code  to  find  every  prime  less  chan  N 

*/ 

#opcion  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (prime/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected. 
* if  DUMMY 

prime (_,  _) . 

♦else 

%  This  program  uses  a  version  of  the  Sieve  of  Erastosthene 
%  to  make  a  list  of  every  prime  number  less  than  N. 

primes(N,  Ps)  integers(2,  N,  Is),  siftds,  Ps)  . 

integers (Low,  High,  (Low  I  Rest]) 

Low  <  High,  ! ,  M  is  Low+1,  integers(M,  High,  Rest), 
integers  (_,  _,  []). 

sift  (  []  ,  (]). 

s  i  ft  ([Ills],  [  X  IPs]  )  removed.  Is,  New),  sift(New,  Ps)  . 

remove (_,  [ ] ,  (] )  . 

remove (P ,  [Ills],  [IlNis]) 

\+  (0  is  I  mod  P)  ,  !,  removed.  Is,  Nis)  . 

removed,  [Ills],  Nis) 

0  is  I  mod  P,  remove (P,  Is,  Nis) . 

Hendi f 
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queen s_4  .m 


#  /* 

queens_4.m:  benchmark  (queens)  queens_4  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s):  $ _ OPTIONS _ $ 

% 

%  (queens)  queens_4 

% 

%  from  Sterling  and  Shapiro,  "The  Art  of  Prolog,"  page  211. 

% 

%  solve  the  4  queens  problem 
#if  BENCH 

#  include  “ -queens_4 . bench" 
lelse 

#opt ion  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

#  if  SHOW 

queens_4  queens (4, Qs) ,  !, 

write  (queens_4) ,  write  (':  '),  write(Qs),  nl. 

#  else 

queens_4  queens ( 4, _),  !. 

#  endif 
#endif 

#include  "queens"  /*  code  for  solving  the  N  queens  problem  */ 
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queen  s__8  .m 


#  /* 

queens_8.m:  benchmark  (queens)  queens_8  master  file 

'/ 

%  generated:  _ MDAY _  _ MONTH _  _ YEAR _ 

%  option (s):  S _ OPTIONS _ $ 

% 

%  (queens)  queens_8 
% 

%  from  Sterling  and  Shapiro,  "The  Art  of  Prolog,"  page  211. 

% 

%  solve  the  8  queens  problem 
#if  BENCH 

♦  include  queens_8. bench" 

#e  lse 

♦  opt ion  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

♦  if  SHOW 

queens_8  queens (8 , Qs)  ,  !, 

write (queens_8) ,  write (' :  '),  write (Qs) ,  nl. 

♦  else 

queens_8  queens (8, _),  !. 

♦  endif 
♦endif 

♦include  "queens"  /*  code  for  solving  the  N  queens  problem  */ 
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queens 


«  /* 

queens:  coae  for  solving  the  N  queens  problem 

«/ 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (queens/2)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.” 

♦if  DUMMY 

queens (_, _) . 

♦else 

%  This  program  solves  the  N  queens  problem:  place  N  pieces  on  an  N 

%  by  N  rectangular  board  so  that  no  two  pieces  are  on  the  same  line 

%  -  horizontal,  vertical,  or  diagonal.  (N  queens  so  placed  on  an  N 

%  by  N  chessboard  are  unable  to  attack  each  other  in  a  single  move 

I  under  the  rules  of  chess.)  The  strategy  is  incremental  generate- 
%  and-test. 

% 

%  A  solution  is  specified  by  a  permutation  of  the  list  of  numbers  1  to 

%  N.  The  first  element  of  the  list  is  the  row  number  for  the  queen  in 

%  the  first  column,  the  second  element  is  the  row  number  for  the  queen 
%  in  the  second  column,  et  cetera.  This  scheme  implicitly  incorporates 
%  the  observation  that  any  solution  of  the  problem  has  exactly  one  queen 
%  in  each  column. 

* 

%  The  program  distinguishes  symmetric  solutions.  For  example, 

% 

%  ?-  queens (4 ,  Qs)  . 

% 

%  produces 

% 

%  Qs  =  (3,1,4,21  ; 

% 

%  Qs  =  (2,4,1,3] 

queens  (N,Qs) 

range ( 1 , N, Ns) , 
queens  (Ns,  ( J ,  Qs)  . 

queens ( ( ] , Qs, Qs) . 

queens (UnplacedQs, SafeQs, Qs) 

select (Q, UnplacedQs, UnplacedQs 1 ) , 

\+  attack  (Q,  SafeQs) , 

queens (UnplacedQsl,  [Q I SafeQs 1 , Qs )  . 

attack  (X,  Xs) 

attack  (X,  1,  Xs)  . 

attack (X, N,  [ Y I _Ys  J ) 

X  is  Y+N  ;  X  is  Y-N. 
attack  (X, N,  (_Y I Ys] ) 

N1  is  N+l, 
attack (X,N1, Ys)  . 

select  (X,  (X  I Xs ] , Xs)  . 

select (X, [YIYsJ, (YIZsJ)  select (X, Ys, Zs) . 

range  (N, N,  (N ] )  !  . 

range (M,N,  [ M I  Ns ] ) 

M  <  N, 

Ml  is  M+l, 
range (Ml, N, Ns) . 

♦er.di  f 
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adder .bench 


#  /* 

set-up . adder :  bench  set-up  for  (circuit)  adder 
*/ 

adaer  :-  driver  (adder)  . 

benchmark (adder, 

circuit (ADDER_SPEC,  _)  , 
dummy (ADDER_SPEC,  _) , 

5)  . 

show (adder)  :-  circuit (ADDER_S?EC,  Solution), 

write  (adder)  ,  write  (':  '),  write  (Solution)  ,  nl 


♦include  "driver" 
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mux . bench 


*  /* 

set-up. mux:  bench  set-up  for  (circuit)  mux 

*./ 

mux  driver(mux). 

benchmark (mux, 

circuit (MUX_SPEC,  _) , 
dummy (MUX_SPEC,  _) , 

50)  . 

show(mux)  circuit (MUX_SPEC,  Solution), 

write (mux),  write (':  ' ) ,  write (Solution) ,  nl. 


♦include  "driver" 
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.concat  1. bench 


*  /« 

set-up . concat_l :  bench  set-up  for  (concat)  concat_l 

*/ 

concat_l  :-  driver (concat_l) . 

benchmark  (concat_l ,  concat([a,b/C],[d,e],_),  dummy  (  [a,  b,  c] ,  [d,  e  ]  /  _)  ,  25000)  . 

show (concat_l)  concat ( [a, b, c] , [d, e] , Z) , 

write  ('  concat  {  fa,  b,  c] ,  [d,  e] , ' )  , 
write(Z),  write(').'),  nl. 


♦include  "driver" 
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concat  6. bench 


*  /* 

set-up . concat_6 :  bench  set-up  for  (concat)  concat_6 
*/ 

concat_6  :-  driver  (concat_6) . 

benchmark (concat_6,  run_concat_6,  dummy,  2S000) . 

show (concat_6)  :-  concat (X, Y,  (a,  b, c, d, e ]) , 
write ( ' concat ( ' ) , 
write  (X),  writet','), 
write(Y),  write  (' ,  (a,  b,  c,  d,  e]  )  . '  ) ,  n 
fail. 

show (concat  6). 


((include  "driver" 
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.hanoi  8. bench 


♦  /* 

set-up. nanoi_8 :  bench  set-up  for  (hanoi)  hanci_8 
*/ 

hanoi_8  :-  driver (hanoi_8) . 

benchmark (hanoi_8,  hanoi  (8),  dummy  (8),  "750). 
♦message  "NOTE:  show/1  is  NOT  defined  for  hanoi_8" 


♦include  "driver" 
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hanoi  16. bench 


♦  /* 

set-up .hanoi_16 :  bench  set-up  for  (hanoi)  hanoi_16 
*/ 

hanoi_16  :-  driver (hanoi_16) . 

benchmark (hanoi_16,  hanoi (16),  dummy (16),  3). 

♦message  "NOTE:  show/1  is  NOT  defined  for  hanoi_16" 


♦include  "driver" 
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mu . bench 


♦  /* 

sec-up. mu:  bench  set-up  for  mu 

*/ 

mu  driver(mu). 

benchmark (mu,  theorem(5,  [m,  u,  i,  i,  u] )  ,  dummy(5,  [m, u, i, i, u] ) ,  250). 
♦message  "NOTE:  show/1  is  NOT  defined  for  mu" 


♦include  "driver” 
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prime_100 .bench 


#  /* 

sec-up. prime_100 :  bench  set-up  for  (prime)  prime_100 

*/ 

prime_100  :-  driver (prime_100) . 

benchmark (prime_100,  primes (100,  _) ,  dummy (100,  _) ,  30). 
show  (prime_100 )  :-  primesdOO,  Ps)  ,  write(Ps),  nl. 


♦  include  ’'driver'' 
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.prime__1000  .bench 


sec-up. prime_1000 :  bench  set-up  for  (prime)  prime_1000 

*/ 

prime_1000  :-  driver (prime_X000) . 

benchmark  (prime_1000,  primes  (1000,  __)  ,  dummy  (1000,  _)  /  3), 
show (prime_1000)  :-  primes (1000,  Ps) ,  write (Ps),  nl. 

♦include  "driver" 
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queen s_4  .bench 


#  /* 

sec-up. queens_4 :  bench  set-up  for  (queens)  queens_4 
*/ 

queens_4  :-  driver (queens_4 ) . 

benchmark (queens_4 ,  (queens (4, _!  ,  !),  (dummy (4,_),  ! ) ,  1000). 

show (queens_4)  :-  queens (4,Qs) ,  !, 

write (queens_4) ,  write)':  '),  write (Qs),  nl. 


♦include  "driver" 
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. queens_8 .bench 


#  /» 


set-up .queens_8 :  bench  set-up  for  (queens)  queens_8 
*/ 

queens_8  driver (queens_8) . 


benchmark  (queens_8,  (queens  (8,  _)  ,  !),  (dummy(8,_),  !)»  50) 


show(queens_8) 


queens (8, Qs) ,  !, 

write (queens_8) ,  write  (': 


write (Qs) , 


((include 


"driver" 


nl . 
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chat_parser 


chat_parser .m  . 

.chat_parser .bench 


1 

21 


chat_par ser .  m 


♦  /* 

chat_parser .m:  benchmark  chat_parser  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s):  $ _ OPTIONS _ $ 

% 

%  chat_parser 
% 

%  Fernando  C.  N.  Pereira  and  David  H.  D.  Warren 
♦if  BENCH 

♦  include  ”.chat_parser. bench" 

♦else 

♦option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

♦  if  SHOW 

chat_parser  string(X), 

write  (X)  ,  nl, 
determinate_say (X, Y) , 
write  (Y)  ,  nl,  nl, 
fail . 

chat_parser . 

♦  else 

chat^parser  string(X), 

determinate_say (X,_) , 
fail. 

chat_parser . 

♦  endif 
♦end if 

♦option  " 

>  The  chat  parser  includes  many  clauses  with 

>  single  occurences  of  variables.  If  option 

>  QUINTUS_PL  is  selected,  then  the  directive 

> 

>  no_style_check (single_var) . 

> 

>  is  generated  to  silence  Quintus  Prolog's 

>  complaining  about  these." 

♦if  QUINTUS_PL 

no_style_check (single_var) . 

♦endif 
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chat_parser .m 


%  query  set 

string ( (what, rivers, are, there,  ? ] ) . 
str ing ( [does, afghani stan, border,  china,  ?])  . 
string ( (what, is, the, capital, of , upper_volta,  ?! )  . 
string ( [where, is, the, largest,  country,  ?] )  . 
string ( (which, country, ' ' ' , s, capital, is, london, ?] ) . 
string  < [which, countries, are,  european,  ?] )  . 
string ( [how, large, is, the, smallest , amer ican,  country, ?] ) . 
string ( [what, is, the, ocean, that, borders, african, countries, 
and,  that , borders, asian, countries, ?] ) . 
string ( [what, are, the, capitals, of , the, countries, border ing, the, bait ic, ?] ) . 
string ( [which,  countries, are, bordered, by, two, seas, ?] ) . 
string ( (how, many, countries, does, the, danube, flow, through, ?] ) . 
string ( [what, is, the, total, area, of, countries, south, of, the, equator, 
and, not, in, australasia, ?] )  . 

string ( [what,  is,  the, average, area, of, the, countries, in, each, con t inent , ? ] )  . 
str ing ([ is, the re, mo re, than, one, country, in, each, cont inent, ? ] ) . 
string ( [ is, there, some, ocean, that, does, not, border, any, country, ?] ) . 
string ( [what, are, the, countries, from, which, a, river, flows, 
into,  the, black_sea, ?] ) . 


%  determinate_say 
#option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (determinate_say/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 

♦  if  DUMMY 

determinate_say (  . 

♦  halt 
♦endif 

determinate_say (X, Y) 

say  (X,  Y)7  !  . 


% - - 

% 

%  xgrun 

% 

% - 

terminal  (T,  S,  S,  x  (_,  terminal,  T,  X)  ,  X)  . 
terminal  (T,  [T  IS],  S,X,  X) 
gap(X)  . 

gap  (x  (gap,  )  . 

gap ( [ ] ) . 

virtual (NT, x (_, nonterminal, NT, X) , X) . 
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% - 

% 

%  ciotab 

% 

% - 

%  normal  form  masks 
is_pp (#(  1, _,_,_)  ) . 
is_pred ( #  (_,  1 ,  _,  _)  )  . 

is_t race 1 , _ ) )  . 

is  adv  (# 

trace  (#(_,_,  1,_)  ,  # (0, 0, 0, 0) )  . 

trace  (#  (0, 0,  1,0)). 

adv(# (0, 0,  0,1)). 

empty  (#(0,0, 0,0))  . 

np_all  (#  (1,  1, 1, 0)  )  . 

s_aU(#(l,  0,1,1))  . 

np_no_trace  (#  (1,  1,  0,0)). 

%  mask  operations 

myplus  (#  (B1,B2,B3,B4)  ,  #  (Cl, C2 , C3, C4 )  ,  #  (Dl.  D2,  D3,  D4 )  ) 
or  (Bl,  Cl,  Dl)  , 
or (82, C2, 02), 
or (B3, C3, D3) , 
or  (B4,  C4,  D4)  . 

minus  (#(B1,B2,B3,B4)  ,  #  (Cl,  C2,  C3,  C4 )  ,  #  (Dl.  D2,  D3,  D4  >  ) 
anot  (Bl ,  Cl,  Dl)  , 
anot (B2 , C2 , D2 ) , 
anot (B3,C3, D  3 ) , 
anot (B4,C4, D4) . 

or  (1,_,  1)  . 
or  ( 0 ,  T,  1)  . 
or (0, 0, 0)  . 

anot  (X,0,X)  . 
anot  (X,  1,0). 

%  noun  phrase  position  features 

role  (sub  j,_,  #(1,0,0)). 

role (compl,_, # ( 0, _ , _ ) ) . 

role (undef , main, # ( _ , 0 , _) ) . 

role  (undef,  aux,  #  (0,  _,  _)  )  . 
role (undef , decl, _) . 
role (nil,  _,_)  . 

sub  j_case  (#(1,0,0))  . 
verb_case  (#  (0, 1,0)). 
prep_case  (#(0,0,1)). 
compl_case ( ♦ (0, _, _) ) . 
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% - 

% 

%  newg 

% 

% - 


say (X, Y) 

sentence (Y, X,  [],[],  !J)  . 


sentence  (B,  C,  D,  E,  F) 

declarative  (B,C,G,E,  H)  , 
terminator (., G, D, H, F)  . 
sentence  (B,  C,  D,  E,  F) 

wh_quest ion (B,C,G,E,H) , 
terminator (?, G, D, H, F)  . 
sentence (8, C, 0, E, F) 
topic (C, G, E, H) , 
wh_quest ion  (B,  G,  I,  H,  J)  , 
terminator  (?,  I,  D,  J,  F)  . 
sentence  (B,  C,  D,  £,  F) 

yn_quest ion (B,  C,  G,  E,  H) , 
terminator (?, G, D, H, F)  . 
sencence  (B,  C,  D,  £,  F) 

imperative (B, C, G, E, H) , 
terminator ( ! , G, D, H, F) . 


pp(B,C.D,E,F,F,G,H) 

virtual  (pp(B,C,D,E),G,H)  . 
pp(pp(B,C)>D,E,F,G,H,I.J) 
prep  (B,  G,  K,  I,L)  , 
prep_case (M) , 

np(C,N,M,0,D,E,F,K,H,L, J)  . 


topic (B,C, D, x (gap, nonterminal , pp (E, compl, F, G) , H) ) 
pp  (E,  compl,  F,  G,  B,  I,  D,  J)  , 
opt_comma ( I, C, J, H)  . 


opt_comma (B, C, D, E) 
’  (' ,'  ,B,C,D,E)  . 
opt_comma (B, B, C, C) 


declarative  (decl  (B)  ,  C,  D,  E,  F) 
s(B,G,C,D,E,F)  . 


wh_question  (whq  (B,  C)  ,  D,  E,  F,  G) 
variable_q(B,H,  I,  J,  D,  K,  F,  L)  , 
quest  ion  (I,  J,  C,  K,  E,  L,  G)  . 


np(B,C,D,E,F,G,H,  I,  I,  J,K) 

virtuai(np(B,C,D,E,F,G,H),J,K)  . 
np  (np  (B,  C,  [])  ,B,D,def,E,F,G,H,  I,J,K) 
i s_pp (F) , 

pers_pron  (C,  3,  L,  H,  I,  J,  K)  , 

empty (G) , 

role  (L,  decl ,  D)  . 

np  (np  (B,C,D),B,E,F,G,H,I,J,K,  L,M) 
is_pp (H) , 

np_head  (C,  B,  F+N,  0,  D,  J,P,L,Q)  , 
np_all  (R)  , 

np_compls  (N,  B,  G,  0,  R,  I,  P,K,  Q,  M)  . 
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np (part (B, C)  , 3+D, E,  inclef,  F ,  G,  H,  I,  J,  K,  L) 
is_pp (G) , 

determiner (B, D, indef , I,  M, K,  N) , 

'  (of ,  M,  0,  N,  P )  , 
s_all(Q), 
prep_case (R) , 

np  (C,  3+plu,R,def  ,F,Q,H,o,  J,P,L)  . 


variable_q  (B,C,D,E,F,G,H,x  (gap,  nonterminal,  np  ( I,  C,  E,  J,  K,  L,  M)  ,  N)  ) 
whq  (B,  C,  I,D,F,G,H,N)  , 
trace (L,M) . 

variable_q  (B,  C,  compl,  D,  E,  F,  G,  x  (gap,  nonterminal ,  pp  (pp  (H,  I)  ,  compl,  J,  K)  ,  L)  ) 
prep (H, E, M, G, N) , 
whq  (B,  C,  1, 0,  M,  F,  N,  L)  , 
trace ( J,K) , 
compl_case (D)  . 

variable_q (B, C, compl, D, E, F,G, x (gap,  nonterminal, 

adv_phrase  (pp  (H,  np  (C, np^head  (int^_det  (B)  ,[],  I)  ,[])),  J,  K)  ,  L)  ) 
con  text  _pr  on  (H,  I,E,F,G,L)  , 
trace  (J,K)  , 
verb_case (D)  . 

variable_q (B, C, compl, D, E, F,G, 

x (gap, nonterminal, predicate (ad j, value (H, wh (B) ) , I) , J) ) 

’  (how,  E,  K,  G,  L)  , 
adj  (quant, H,K,F,L,J)  , 
dmpty  (I) , 
verb  case  (h)  . 


adv_phrase (B, C, d,e, E,  F,  G) 

virtual  (adv_phrase  (B,C,D)  ,F,G)  . 
adv_phrase (pp (B,C) , D, E, F, G, H, X) 
loc_pred  (B,  F,  J,  H,  K)  , 

PP(PP(prep(of),C) ,  compl,  D,E,  J,  G,K,  I)  . 


predicate (B,C, D, E, E, F,G) 

virtual (predicate (B, C, D) ,F,G) . 
predicate  (B,C,D,E,F,G,H) 
adj_phrase(C,D,E,F,G,H)  . 
predicate (neg, B, C, D, E,F, G) 
s_all (H) , 

pp(B,  compl,  H,C,D,E,F,G)  . 
predicate (B,C, D, E, F, G,  H) 
s_all (I) , 

adv_phrase (C, I, D, E,F, G, H)  . 


whq  (B,  C,  D,  undef ,  E,  F,  G,  H) 
int_det  (B,C,  E,  I,  G,  J)  , 
s_all  (K) , 

np  (D,  C,  L,M,  sub  j ,  K,  N,  I,  F,  >T,  H)  . 
whq(B,  3+C,  np  (3+C,  wh  (B)  ,  [  ] )  ,  D,  E,  F,  G,  H) 
int_pron (D, E, F, G, H) . 


int_det (B, 3+C, D, E,F,  G) 
whose  (B,  C,  D,  E,  F,  G)  . 
int_det (B, 3+C, D,E, F,G) 
int_art (B, C, D, E,  F,G)  . 


gen_marker  (B,  B,  C,  D) 

virtual (gen_marker, C, D) . 
gen_mar)<er  (B,  C,  D,  E) 

*  ('  w  ,B,F,D,G)  , 
an_s (F, C, G, E)  . 
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whose (B, C, D,E, F, x (nogap, nonterminal, np_headO (wh (B) ,  C, proper) , 
x (nogap, nonterminal , gen_marker , G) ) ) 

'  (whose,  D,E,F,G)  . 


question  (B,C,  D,E,F,  G,  H) 
subj_question (B) , 
role {subj, I, C) , 
s(D,  J,E,F,G,H)  . 
quest  ion  (B,  C,  D,  E,  F,  G,  H) 

f ronted_verb (B, C, E, I, G, J) , 
s(D,K,  I ,  F,  J,  H)  . 


det  (B,C,D,E,E,F,G) 

virtual  (det(B,C,D),F,G)  . 
det  (det  (B)  ,  C,  D,E,F,G,  H) 
terminal  (I,E,F,G,H), 
det  (I,  C,  B,  D)  . 

det (generic, B, generic, C, C, D, D)  . 


int_art  (B,  C,  D,  E,  F,  x  (nogap,  nonterminal,  det  (G,  C,  def )  ,  H)  ) 
int_art(B,C,G,D,E,F,H)  . 


sub j_question (subj) . 
sub j_question (undef ) . 


yn_question(q(B)  ,C,D,E,F) 

fronted_verb(nil,G,C,H,E,  I)  , 
s  (B,  J,  H,  D,  X,  F)  . 


verb_form (B, C,  D, E,  F,  F,G,  H) 

virtual  (verb_form (B,C,D,E)  ,G,H)  . 
verb_form (B,C,D,E,F,G,H,  I) 
terminal (J,F,G, H, I) , 
verb_form  ( J,  B,  C,  D)  . 


neg (B, C, D, D,E,  F) 

virtual (neg (B, C) , E, F)  . 
neg (aux+B, neg, C, D, E, F) 

' (not, C, D, E, F)  . 
neg  (B,  pos,  C,  C,  D,  D)  . 


front ed_verb (B, C, D, E, F, x (gap, nonterminal , verb_form (G, H, I, J) , 
x (nogap, nonterminal, neg (K, L) , M) ) ) 
verb_f  orm  (G,  H,I,N,D,0,F,P), 
verb_type (G, aux+Q) , 
role (B, J, C) , 
neg  (R,  L,  0,  E,  P,  M)  . 


imperative ( imp (B) , C, D,E, F) 
imperat ive_verb (C, G,  E,  H)  , 
s  (B,  I,  G,  D,  H,  F)  . 


imperat ive_verb (B, C, D, x (nogap, terminal, you, x (nogap, nonterminal 
verb_form  (E,  imp+f  in,  2+sin,main),F))) 
verb_form  (E,  inf ,  G,  H,  B,  C,  D,  F)  . 
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s(s(B,C,D,E),F,G,H,I,  J) 
sub j  (B,K,L,G,M,  I,N)  , 
verb  (C,  K,  L,  0,  M,  P,  N,  Q)  , 
empty (R) , 
s_all (S) , 

verb_args  (L,0,D,R,T,P,U,Q,V)  , 

minus (S, T,  W)  , 

myplus (S, T,  X) , 

verb_mods  (E,  W,  X,  F,  U,  H,  V,  J)  . 


sub  j (there, B, C+be, D, E, F, G) 

'  (there,  D,  E,  F,  G)  . 
sub  j  (B,C,D,E,F,G,H)  S- 
s_all  (I) , 
subj_case  ( J)  , 

np  (B,  C,  J,  K,  sub  j ,  I,  L,  E,  F,  G,  H)  . 


np_head (B,  C, D,  E,  F,  G,  H,  I,  J) 
np_headO  (K,  L,  M,  G,  N,  I,  0)  , 

possessive  (K,  L,  M,P,P,  B,  C,  D,  E,F,  N,  H,  O,  J)  . 


np_headO (B, C, D, E, E, F,  G) 

virtual (np_headO (B,C,D) ,F,G)  . 

np_headO (name (B) , 3+sin, def +proper , C, D, E, F)  : - 
name (B, C, D, E, F)  . 

np_headO (np_head (B, C, D) , 3+E, F +common, G, H, I,  J)  :  - 
determiner  (B,E,F,G,K,I,L), 
adjs  (C,  K,M,  L,N)  , 
noun  (D,E,M,H,N,J)  . 

np_headO (B, C, def+proper, D, E, F, x (nogap, nonterminal , gen_marker,  G) ) 
poss_pron (B, C, D, E, F, G)  . 

np_headO (np_head (B, []/ C) , 3+sin, indef +common, D, E, F, G)  : - 
quant  if ier_pron (B, C, 0, E,F,  G) . 


np_compls (proper, B, C, ( ] , D, E, F, F, G, G) 
empty (E) . 

np_compls  ( common,  B,C,D,E,F,G,H,I,J) 
np_all (K) , 

np_mods  (B,C,L,D,E,M, K,N,G,0,  I,P)  , 
relat  ive  (B,  L,  M,  N,  F,0,  H,  P,  J)  . 


possessive  (B,  C,  0,  (],E,F,G,H,  I,  J,K,  L,  M,  N) 
gen_case (K, 0, M, P) , 
np_headO (Q, R, S,  0,  T, P,  0) , 

possessive  (Q,  R,  S,  V,  (pp  (poss,  np  (C,  B,  E)  )  I V] ,  F,  G,  H,  I,  J,  T,  L,  U,  N)  . 
possessive  (B,C,D,E,F,B,C,D,E,F,G,G,H,H). 


gen_case  (B,  C,  D,  x  (nogap,  terminal,  the,  E)  )  :  - 
gen_marker (B,C, D, E) . 


an_s (B, C, D, E) 

'  (s,  B,  C,  D,  E)  . 


an_s (B, B, C, C)  . 


determiner (B, C, D, E, F, G, H) 
det(B,C,D,E,F,G,H)  . 
determiner (B, C, D, E, F, G, H) 

quant  _phrase  (B,  C,  D,  E,  F,  G,  H)  . 
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quant_phrase  (quant  (B,C),D,E,F,G,H,I) 
quant  (B,  E,  F,  J,  H,  K) , 
number  (C,D,J,G,K,  I)  . 


quant  (B,  indef,  C,  D,  E,  F) 
neg_adv  (G,  B,  C,H,E,  I)  , 
comp_adv  (G,  H,  J,  I,  K)  , 

'  (than,  J,D,K,F)  . 
quant (B,  indef, C, D, E, F) 

'  (at,  C,  G,  E,  H)  , 
sup_ad v  (I,G,D,H,F)  , 
sup_op (I, B) . 
quant  (the,  def,  B,  C,  D,  E) 

'  (the,B,C,  D,E)  . 
quant ( same , inde  f , B , B , C ,  C )  . 


neg_adv (B, not +B, C, D, E, F) 
' (not, C, D,  E,  F)  . 
neg_adv(B, 3, C, C, D, D)  . 


sup_op (least, not +less) . 
sup_op (most , not+more) . 


np_mods(B,C,D,  (E  IF]  ,  G, H,  I,  J,  K,  L, M,  N) 
np_mod(B,C,E,G,0,K,P,M,Q)  , 
trace (R) , 
myplus (R, 0, S) , 
minus (G, S, T) , 
myplus (O, G, U) , 

np_mods  (B,  C,D,F,T/H,U,J,P,L,Q,N)  . 
np_mods(B,C,D,D,E,E,F,F,G,G,H,H)  . 


np_mod  (B,  C,  D,  E,  F,G,  H,  I,  J) 
pp(D,C,E,F,G,H,X,  J)  . 
np_mod  (B,  C,  D,  E,  F,  G,  H,  I,  J) 

reduced_relat ive  (B,D,E,F,G,H,I,J)  . 


verb_mods  ((B|C],D,E,F,G,H,I,J) 
verb_mod  (B,  D,  K,  G,  L,  I,  M) , 
trace (N) , 
myplus  (N,  K,  O)  , 
minus (D,0, P) , 
myplus  (K,  D,  Q)  , 
verb_mods  (C,P,Q,F,L,  H,M,  J)  . 
verb_mods  (  (] ,  B,  C,  C,  D,  D,  E,  E)  . 


verb_mod (B, C, D, E, F, G,  H) 

adv_phra3e (B, C, D, E, F, G, H) . 
verb_mod (B, C, D,E,F,  G,  H) 
is_adv (C) , 
adverb  (B,E,F,G,H)  , 
empty (D) . 

verb_mod  (B,  C,  D,  E,  F,  G,  H) 

pp  (B,  compl,  C,  D,  E,  F,  G,  H)  . 


adjs ( !BIC] , D,E,F,G) 
pre_ad  j  (B,  D,  H,  F,  I), 
ad  js  (C,  H,  E,  I ,  G)  . 
ad js  (  (],B,B,C,C)  . 
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pre_ad  j  (B,  C,  D,  E,  F) 
adj(G,B,C,D,E,F>  . 
pre_ad j (B, C, D, E, F) 

sup_phrase (B, C, D, E, F) . 


sup_phrase (sup (most,B),C,D,E,F) 
sup_ad  j  (B,  C,  D,  E,  F)  . 
sup_phrase  (sup  (B,  C)  ,  D,  E,  F,  G) 
sup_adv  (B,  D,  I,F,J)  , 
adj (quant, C, I, E, J, G)  . 


comp_phrase  (comp  (B,C,D),E,F,G,H,I)  :  - 

comp  (B,  C,  F,  J,  H,  K)  , 
np_n°_trace (L) , 
prep_case (M) , 

np  (D,  N,  M,  0,  compl,  L,E,J,G,K,I)  . 


comp  (B,  C,  D,  E,  F,  G) 

comp_adv (B, D, H, F,  I) , 
adj  (quant,  C,  H,  J,  I,K) , 
' (than,  J,E, K, G)  . 
comp (more, B,C, D, E, F) 
rel_ad  j  (B,C,G,E,H)  , 

'  (than,  G,  D,  H,  F)  . 
comp  (same,  B,  C,  D,  E,  F) 

'  (as,  C,  G,  E,  H)  , 
adj(quant,B,G,I,H,J), 
'  (as,  I ,  D,  J,  F)  . 


relatives,  [C] ,  D,  E,  F,  G,  H,  X,  J) 
isjred  (D)  , 

rel_con  j  (B,K,C,F,G,H,I,J)  . 
relative  (B,  (] ,  C,  □,  D,  E,E,  F,  F)  . 


rel_con j  (B,C,D,E,F,G,H,  I) 
rel  (B,  J,  K,  F,  L,  H,M) , 
cel  rest  (B,C,  J,  D,  K,  E,  L,  G,  M,  I)  . 


rel_rest  (B, C,  D, E, F, G,  H,  I,  J, K) 
con  j  (C,L,D,M,E,H,N,J,0), 
re l_con  j  (B,L,M, G,N,I,0,K)  . 
rel_rest  (B,C,D,D,E,E,F,F,G,G)  . 


rel  (B,  rel  (C,D»  ,E,F,G,H,I) 
open  (F,  J,  H,  K)  , 
variable  (B,  C,  J,  L,  K,  M)  , 
s  (D,  N,  L,  0,  M,  P)  , 
trace (Q) , 
minus  (N,Q,  E)  , 
close (0, G, P ,  I)  . 


variable  (B, C,  D, E,F, x  (gap,  nonterminal,  np  (np (B,  wh  (C)  ,  []  )  ,B,G,H,  I, 
’ (that,  D,E, F, L) , 
trace ( J, K)  . 

variable  (B,  C,  D,  E,F,  x  (gap,  nonterminal,  np  (G,  H,  I,  J,  K,  L, M) ,  N) )  :  - 

wh  (C,  B,  G,  H,  I ,  D,  E,  F,  N)  , 
trace  (L,M)  , 

var  iable  (B,  C,  D,  E,  F,  x  (gap,  nonterminal,  pp  (pp  (G,  H)  ,  compl,  I,  J)  ,  K)  ) 
prep (G, D, L, F,M) , 
wh  (C,B,  H,N,0,  L,  E,  M,  K) , 
trace ( I, J) , 
compl_case (0) . 


,  K)  ,  L)  )  :  - 
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wh(B,C,np(C,wh(B)  ,  []  )  ,  C,  D,  E,  F,  G,  H) 
rel_pron<I,E,F,G,H)  , 
role  (I,  decl,  D)  . 

wh  (B,  C,  np  (D,  E,  [pp  (F,G)]),D,H,I,J,K,L) 
np_headO (E, D, M+common, I, N, K, 0) , 
prep (F ,  N,  P,  0, Q) , 
wh(B,C,G,R,S,P,J,Q,L)  . 
wh(B,C,D,E,F,G.H,  I,  J) 
whose  (B,C,G,K,  I,  L)  , 
s_all (M) , 

np (D, E,  F, def ,  sub  j ,  M,  N,K,H,L,J)  . 


reduced_relat  ive(B,C,D,E,F,G(H,I)  :  - 
is_pred (D) , 

reduced  rel_con j (B,J,  C,E,F,G,H,I)  . 


reduced_rel_con j  (B,C,D,E,F,G,H,I) 
reduced_rel  (B,  J,  K,  F,  L,  H,M)  , 
reduced  rel_rest  (B,  C,  J,  D,  K,  E,L,  G,  M,  I)  . 


reduced_rel_rest  (B,C(D,E,F,G,H,I,J,K) 
con  j  (C<L,D,M>E>H,N>J>0) , 
reduced_rel_con j (B, L, M, G, N, I, 0, K) . 
reduced_rel_rest (B, C, D, D, E, E, F, F, G, G)  . 


reduced_rel  (B,  reducedrel  (C,D),E,F(G,H,I) 
open  (F,  J,  H,  K)  , 
reduced_wh  (B,  C,  J,  L,  K,  M)  , 
s(D,N,L,0,M,P)  , 
trace  (Q) , 
minus (N, Q, E) , 
close (0,G,P, I)  . 


reduced_wh (B, C, D, E, F, x (nogap, nonterminal, 

np  (np  (B,  wh  (C)  ,  ( ] )  ,  B,  G,  H,  I,  J,  K) ,  x  {nogap,  nonterminal, 
verb_form (be, p res + fin, B, main) , x (nogap, nonterminal, 
neg (L, M) , x (nogap, nonterminal, predicate (M, N, 0) , P) ) ) ) ) 
neg  (Q,  M,  D,  R,  F,  S)  , 
predicate  (M,  N,0,  R,E,  S,  P) , 
trace (J,K) , 
sub j_case (G)  . 

reduced_wh (B, C, D, E, F, x (nogap, nonterminal, 

np  (np  (B,  wh  (C)  ,  [  ] )  ,  B,  G,  H,  I,  J,  K)  ,  x  (nogap,  nonterminal, 
verb  (L,  M,  N,  0)  ,  P)  )  ) 
participle  (L,  N,  O,  D,  E,  F,  P)  , 
trace  (J,K)  , 
sub j_case (G)  . 

reduced_wh (B, C, D,E, F, x (nogap, nonterminal, 

np  (G,  H,  I,  J,  K,  L,  M)  ,  x  (gap,  nonterminal, 
np  (np  (B,  wh  (C)  ,  (] ) ,  B,  N,  0,  P, Q,  R)  ,  S)  )  ) 
s_all (T) , 
subj_case (I) , 
verb_case (N) , 

np  (G,  H,  U,  J,  sub  j  ,T,V,D,E,F,S)  , 
trace  (L,M)  , 
trace  (Q,  R)  . 
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verb  (B,C,D,E,F,F,G,H) 

virtual (verb  (B,  C,  D,  E)  ,  G,  H)  . 
verb(verb(B,C,D  +  fin,E,F),G,H,C,I,J,K,L) 
verb_f orm (M,  D+f in, G, N,  1, 0,  K,  P)  , 
verb_type (M, Q) , 
neg(Q,F,0,R,P,S)  , 
rest_verb (N,  M,B,C,  E,  R,  J,  S,  L)  , 
verb_type  (B,  H)  . 


rest_verb (aux, have, B, C, [perf I D] »E, F, G, H) 
verb_form(  I,  past+part ,  J,K,E,L,G,M), 
have  (I,B,C(D,L,F,M,  H)  . 
rest_verb  (aux,  be,B,C,D,E,F,G,H) 
verb_form(  I,J,K,L,E,M,G,N)  , 
be  ( J,  I ,  B,  C,  D,  M,  F,  N,  H)  . 
rest_verb  (aux,  do,  B,  active,  [],C,D,E,F) 
verb_form(B,  inf,G,H,C,D,E,F)  . 
rest_verb  (main,  B,B,  active,  (],C,C,0,D)  . 


have  (be, B, C,  D, E, F, G,  H)  :~ 

verb_form(I,  J,K,  L,  E,  M,  G,  N)  , 
be(J,I,B,C,D,M,  F,N,H)  . 
have (B,B, active, (] , C, C, D, D) . 


be  (past+part,  B,  B,  passive,  U,C,C,D,D)  . 
be (pres+part, B, C, D, [prog] , E, F, G, H) 
passive (B, C, D,E, F,G, H)  . 


passive (be, B, passive, C, D, E,F) 

verb_form(B, past+part , G, H,  C, D,  E, F) , 
verb_type  IB,  I) , 
passive (I) . 

passive  (B,  B,  act  ive,  C,  C,  D,  D)  . 


participle  (verb  (B,  C,  inf ,  D,  E)  ,  F,  C,  G,  H,  I,  J)  : ~ 
neg  (K,  E,  G,  L,  I,M)  , 
verb_form (B,  N,0,P,L,H,M,J)  , 
participle (N, C, D) , 
verb_type (B, F) . 


passive (B+trans) . 
passive (B+ditrans) . 


participle (pres+part, active,  [prog])  . 
participle (past+part, passive, (] ) . 


close (B, B, C, 0) 

virtuai(close,C,3!  . 


open (B, B, C, x (gap, nonterminal,  close,  C)  )  . 
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verb_args  (B+C,  D,  E,  F,  G,  H,  I ,  J,  K)  :  - 
advs  (E,L,M,  H,N,J,0)  , 
verb_args  (C,D,L,  F,G,N,I,0,K)  . 
verb_args ( trans, act ive, [arg (dir , B) ],C,D,E,F,G,H)  :  - 

verb_arg  (np,B,D,E,F,G,H)  . 
verb_args (ditrans, B, [arg(C,D) I E] ,  F,  G,  H,  I,  J,  K) 
verb_arg  (np,  D,  L,  H,  M,  J,  N)  , 
object  (C,E,L,G,M,  I,N,K)  . 
verb_args (be, B, [void] ,C,C, D, E, F,G) 
terminal  (there,  D,  E,  F,  G)  . 
verb_args (be, B, [arg (predicate, C) ], D, E, F, G, H, X) 
pred_con  j  (J,C,E,F,G,  H,I)  . 
verb_args  (be,  B,  [arg  (dir,C)],D,E,F,G,H,I) 
verb_arg  (i.p,  C,  E,  F,  G,  H,  I)  . 
verb_args (have, active, (arg (dir, B)],C,D,E,F,G,H) 
verb_arg  (np,  B,  D,  E,  F,  G,  H)  . 
verb_args (B, C, [ ] , D, D, E, E, F, F) 
no_args  (B)  . 


object  (B, C,  D, E,  F, G,  H,  I) 
adv ( J) , 
minus ( J, D, K) , 
advs  (C,L,K,F,M,  H,N)  , 
ob  j  (B,  L,  D,  E,  M, G,  N,  I)  . 


obj  (ind,  [arg  (dir,B)],C,D,E,F,G,H) 
verb_arg  (np,  B,  D,  E,  F,  G,  H)  . 
obj (dir,  ( ] ,  B,  B, C, C,  D,  D)  . 


pred__con  j  (B, C,  D, E,  F, G,  H)  :~ 
predicate  (I,  J, K,  E,  L,  G,M) , 
pred_rest (B, J,C, K, D, L, F,M,  H)  . 


pred_rest  (B,C,  D,  E,  F,  G,  H,  I,  J) 
con  j  (B,K,C,L,D,G,M,  I,N), 
pred_con  j  (K,  L,  F,  M,  H,  N,  J)  . 
pred_rest (B, C, C, D, D, E, E, F, F)  . 


verb_arg (np,B, C, D, E, F,G) 
s_all (H), 
verb_case (I) , 

np  (B,  J,  I,K,  comp  I,  H,C,D,E,F,G)  . 


advs ( [BIC] , D,E,F,G, H, I) 
is_adv(E) , 
adverb  (B,F,J,H,K), 
advs  (C,D,E,J,G,K,  I)  . 
advs  (B,B,  C,  D,  D,  E,  E)  . 


ad j_phrase (B, C, D, E, F,  G) 
adj  (H,B,D,E,F,G)  , 
empty (C) . 

adj_phrase (B, C, D,E, F, G) 

comp_phrase (B, C, D, E, F, G) . 


no_args (trans)  . 
no_args (ditrans) . 
no_args (intrans) . 


con  j  (con  j  (B,  C)  ,  con  j  (B,D)  ,E,F,  conj  (B,E,F)  ,G,H,  I,  J) 
con  j  (B,C,D,G,H,  I,  J)  . 
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noun (B, C, D, E, F,  G) 

terminal  (H,  D,  E,  F,  G)  , 
noun  form(H, B, C)  . 


ad  j  (B,  ad  j  (C) ,  D,E,F,  G) 
Cerminal  (C,  D,  E,  F,  G) , 
adj (C,  B) . 


prep (prep (B) , C, D, E, F) 
terminal (B,  C,  D,  E,  F)  , 
prep (B) . 


rel_adj (adj (B) ,C,D,E,F) 
terminal  (G,  C,  D,  E,  F)  , 
rel_ad j (G, B) . 


sup_ad j  (ad j  (B)  , C,  D,  E,  F) 
terminal  (G,C,D,E,F)  , 
sup_adj (G,B) . 


comp_adv (less, 8, C, D, E) 
'  (less,B,C,D,E)  . 
comp_adv (more, B, C, D, E) 
' (more, B,C, D, E)  . 


sup_adv ( least , B, C, D, E) 
'  (least, B,C,D,E)  . 
sup_adv (most, B, C, D, E) 

* (most, B, C, D,E)  . 


rel_pron (B, C, D, E, F) 

terminal  (G,C,D,E,F)  , 
rel_pron (G, B) . 


name (B,C, D,E,F) 

opt_the  (C, G, E,  H)  , 
terminal  (B,  G,  D,  H,  F)  , 
name (B) . 


int_art (B, plu, quant (same, wh(B)),C,D,E,F) 
'  (how,  C,  G,  E,  H)  , 

'  (many, G, D, H, F)  . 
int_art (B, C, D, E, F, G,  H) 
terminal  (I,E,F,G,H)  , 
int_art (I, B, C, D)  . 


int_pron (B, C, 0, E, F) 

terminal  (G, C,D, E, F)  , 
int_pron (G, B) . 


adverb (adv (B) , C, D, E, F) 
terminal  (B,  C,  0,  E,  F) , 
adverb  (B)  . 


poss_pron (pronoun (B),C+D,E,F,G,H) 
terminal  (I,E,F,G,H), 
poss_pron  ( I,  B,  C,  D)  . 
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per  s_pron  (pronoun  (B),C+D,E,F,G,H,I)  :  - 

terminal  (J,  F,G,  H,  I)  , 
pers_pron ( J, B, C, D, E)  . 


quant ifier_pron (B, C, D,E, F, G) 
terminal  (H,  D,  E,  F,  G)  , 
quant  if ier_pron (H, B, C)  . 


context_pron (prep (in) , place, B, C, D,  E) 
'  (where,  B,  C,  D,  E)  . 

context_pron (prep (at) , t ime, B, C, D, E) 

' (when, B, C, D, E)  . 


number  (nb  (B) ,  C,  D,  E,  F,  G) 
terminal  (H,D,E,F,G), 
number (H, B, C) . 


terminator (B, C, D,E, F) 
terminal  (G,C,D,E,F)  , 
terminator (G, B) . 


opt_the  (B,  B,  C,  C)  . 
opt_the (B, C, D, E) 

'  (the ,  B,  C,  D,  E)  . 


con  j  (B,  list ,  list , C, D, E, F) 
terminal  ('  ,  '  ,  C,  D,  E,  F)  . 
con  j (B,  list, ' end' , C, D, E, F) 
terminal (B, C, D, E, F) , 
conj (B) . 


loc_pred (B, C, D,  E,  F) 

terminal  (G,  C,  D,  E,  F)  , 
loc_pred (G, B)  . 


MB,C,D,E,F) 

terminal  (B,  C,  D,  E,  F)  , 
'  (B)  . 
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% - 

% 

%  newdic 

% 

% - 

word(Word)  '(Word). 

word(Word)  conj(Kord). 

word(Word)  adverb (Word) . 

word(Word)  sup_ad j (Word, _) . 

word(Word)  rel_ad j (Word, _) . 

word  (Word)  adj(Word,_). 

word (Word)  name (Word). 

word (Word)  terminator (Word, _) . 

word(Word)  pers_pron  (Word,  . 

word(Word)  poss_pron (Word, _,_,_) - 

word(Word)  rel_pron (Word, _) . 

word (Word)  verb_form (Word, _,_,_) . 

word(Word)  noun_form(Word,_,_)  . 

word(Word)  prep(Word). 

word(Word)  quant  if ier_pron (Word,  _,_)  . 

word(Word)  number  (Word, _,_)  . 

word  (Word)  det  (Word,  _,_,_)  . 

word(Word)  int_art  (Word, _,_,_)  . 

word(Word)  int_pron (Word, _) . 

word (Word)  loc_pred (Word, _) . 

'  (how)  . 

’ (whose) . 

'  (there)  . 

'  (of)  . 

'('’*).  %  use  ’  instead  of  '  to  help  assembler 

'(','). 

’  (s)  . 

’  (than)  . 

'  (at)  . 

' (the)  . 

’ (not)  . 

' (as)  . 

' (that)  . 

’  (less)  . 

' (more)  . 

’  (least)  . 

’ (most)  . 

' (many) . 

' (where)  . 

’ (when)  . 

conj (and)  . 
con  j  (or)  . 

int_pron (what , undef ) . 
int_pron (which, undef) . 
int_pron (who, subj ) . 
int_pron (whom, compl) . 

int_art (what,  X, _, int_det (X) )  . 
int_art (which, X, _, int_det (X) ) . 

det (the, No, the (No) , def ) . 
det (a, sin, a, indef )  . 
det (an, sin, a, indef) . 
det  (every,  sin,  every,  indef)  , 
det (some, _, some, indef) . 
det  (any,  _,  any,  indef)  . 
det  (all,plu,all,  indef)  . 
det (each, sin, each, indef )  . 
det (no,_, no, indef)  . 
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number (W, I, Nb) 

tr_number  (W,  I)  , 
ag_numbe  r ( I ,  Nb ) . 

tr_number  (nb  (I)  ,  I)  . 
tr_number (one,  1)  . 
tr_number  (two,  2)  . 
tr_number (three,  3)  . 
tr_number (four,  4)  . 
tr_number (f ive, 5)  . 
t  r_numbe  r ( s ix ,  6 )  . 
tr_number (seven,  7)  . 
tr_number (eight,  8)  . 
t  r_numbe  r ( n ine , 9 )  . 
tr_number  (ten,  10)  . 

ag_number ( 1, sin)  . 
ag_number (N,plu)  N>1. 

quantifier_pron (everybody, every, person) . 
quantifier_pron (everyone, every, person) . 
quantifier_pron (everything, every,  thing)  . 
quantifier_pron (somebody,  some,  person)  . 
quant i fie r_pr on (someone,  some,  person)  . 
quant ifier_pron (something, some, thing) . 
quant  if ier_pron (anybody, any, person) . 
quant i fie r_pr on (anyone,  any, person) . 
quantifier_pron (anything, any, thing) . 
quant i fie r_pron (nobody, no, person) . 
quant  if ier_pron (nothing, no, thing)  . 

prep  (as)  . 
prep (at) . 
prep (of) . 
prep (to)  . 
prep  (by)  . 
prep (with) . 
prep (in)  . 
prep  (on)  . 
prep (from) . 
prep ( into) . 
prep (through) . 

noun_form (Plu, Sin, plu)  noun_plu (Plu, Sin) . 

noun_form (Sin, Sin, sin)  noun_sin (Sin) . 

noun_form (proportion, proportion, _) . 
noun_form (percentage, percentage, _) . 

root_form(l+sin) . 

root_form  ( 2 _ )  . 

root_form ( 1+plu) , 
root_form (3+plu) . 

verb_root (be) . 
verb_root (have) . 
verb_root (do) . 
verb_root  (border)  . 
verb_root (contain) . 
verb_root (drain) . 
verb_root (exceed) . 
verb_root (flow) . 
verb  root (rise). 


chat_parser  •  16 


chat__parser . 


regular_pres (have)  . 
regular_pres (do)  . 
regular_pres (rise) . 
regular_pres (border ) . 
regular_pres (contain)  . 
regular_pres (drain) . 
regular_pres (exceed) . 
regular_pres (f low) . 

regular_past (had, have)  . 
regular_past (bordered, border) . 
regular_past (contained,  contain)  . 
regular_past (drained, drain) . 
regular_past (exceeded, exceed) . 
regular_past (flowed, flow) . 

rel_pron (who,  subj )  . 
rel_pron (whom, compl) . 
rel_pron  (which,  undef)  . 

poss_pron (my,_, 1, sin) . 
poss_pron (your , _, 2,  _) . 
poss_pron (his, masc, 3, sin) . 
poss_pron (her, fem, 3, sin) . 
poss_pron (its, neut , 3, sin) . 
poss_pron  (our,_,  l,plu)  . 
poss_pron (their , _,  3, plu) . 

pers_pron (i,_, 1, sin, subj) . 
pers  pron  (you,  2,_,  _)  . 
pers_pron (he, masc, 3, sin, subj) . 
pers_pron (she, fern, 3, sin, subj) . 
pers_pron (it, neut, 3, sin,_) . 
pers_pron  (we,_,  l,plu,  subj)  . 
pers_pron  (them,_,  3,  plu,  subj)  . 
pers_pron (me, _, 1, sin, compl (_) ) . 
pers_pron (him, masc, 3, sin, compl (_) ) . 
pers_pron (her, fem, 3, sin, compl (_) ) . 
pers_pron  (us,_,  l,plu,  compl  (_)  )  . 
pers_pron (them,_, 3, plu, compl (_) ) . 

terminator ( . , _) . 
terminator  (7,7)  , 
terminator  (!,!). 

name  (  )  . 
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%  specialised  dictionary 

loc_pred  (east,  prep  (eastof)  )  . 
loc_pred (west, prep (westof ) ) . 
loc  pred  (north,  prep  <northof)  )  . 
Ioc_pred (south, prep (southof )  )  . 

adj (minimum, restr)  . 
adj (maximum,  restr)  . 
adj (average, restr )  . 
adj  (total,  restr)  . 
adj (african, restr )  . 
adj (american, restr)  . 
adj (asian, restr) . 
adj (european, restr)  . 
adj (great , quant ) . 
adj (big, quant) . 
adj (small, quant) . 
adj (large, quant ) . 
adj (old, quant ) . 
adj (new, quant) . 
ad j (populous, quant ) . 

rel_adj (greater, great) . 
re l_ad  j(less, small)  . 
rel_adj (bigger, big) . 
rel_ad j  (smaller,  small)  . 
rel_ad j (larger, large) . 
rel_adj (older, old) . 
rel_ad j (newer, new) . 

sup _adj (biggest, big) . 
sup_adj (smallest, small) . 
supadj (largest, large) . 
sup_adj (oldest, old) . 
sup_adj (newest, new) . 

noun_sin (average) . 
noun_sin (total) . 
noun_sin (sum) . 
noun_sin (degree) . 
noun_sin (sqmile) . 
noun_sin (ksqmile) . 
noun_sin (thousand) . 
noun_sin (million) . 
noun  sin (time) . 
noun_sin (place) . 
noun_sin (area) . 
noun_sin (capital) . 
noun_sin (city) . 
noun_sin (continent) . 
noun_sin (country) . 
noun_sin ( latitude) . 
noun_sin ( longitude) . 
noun_sin (ocean) . 
noun_sin (person) . 
noun_sin (population) . 
noun_sin (region) . 
noun_sin ( river) . 
noun_sin (sea) . 
noun_sin (seamass) . 
noun  sin  (number)  . 
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noun_plu  (averages,  average)  . 
noun_plu (totals, total) . 
r,oun_plu  (sums,  sum)  . 
nourt_plu  (degrees, degree)  . 
noun_plu (sqmiles,  sqmile) . 
noun_plu (ksqmiles, ksqmile) . 
noun_plu (million, million) . 
noun  piu (thousand, thousand) . 
noun_plu  (times,  time)  . 
noun_plu (places, place) . 
noun_plu  (areas,  area)  . 
noun_plu (capitals,  capital) . 
noun_plu (cities, city) . 
noun  plu (continents, continent) . 
noun_plu (countries, country) . 
noun_plu (latitudes, latitude) . 
noun_plu (longitudes, longitude) . 
noun_plu (oceans, ocean) . 

noun_plu (persons, person) .  noun_plu (people, person) . 

noun_plu (populat ions, popu  at ion) . 

noun_plu (regions, region) . 

noun_plu ( rivers,  river)  . 

noun_plu (seas,  sea) . 

noun  plu (seamasses, seamass) . 

noun_plu (numbers, number) . 

verb_form(V,  V,  inf,_)  verb_root  (V)  . 

verb_form (V, V, pres+f in,  Agmt) 
regular_pres (V)  , 
root_form(Agmt)  , 
verb_root (V) . 

verb_form (Past , Root , past+_,_) 
regular_past (Past, Root) . 

verb_form (am, be, pres  +  f in,  1+sin) . 
verb_form (are, be, pres+f in,  2+sin)  . 
verb_form(is,be,pres  +  fin,  3+sin) . 
verb_form (are, be, pres+f in, _+plu) . 
verb_form (was,  be,  past +f in,  1+sin)  . 
verb_form (were, be,past  +  fin,2+s_n)  . 
verb_form (was,be,past+fin,3+sin)  . 
verb_form (were, be, past+f in, _+plu) . 
verb_form (been, be, past+part, _) . 
verb_form(being, be, pres+part, _)  . 
verb_form (has, have, pres  +  f in,  3  +  sin) . 
verb_form (having, have, pres+part ,_) . 
verb_form (does, do, pres+f in,  3+sin)  . 
verb_form (did, do, past+f in, _) . 
verb_form (doing, do, pres+part, _) . 
verb_form (done, do, past+part, _) . 
verb_form (flows, flow, pres  +  f in,  3+sin) . 
verb_form ( flowing, flow, pres+part,  _)  . 
verb_form (rises, rise, pres  +  f in,  3+sin)  . 
verb_form (rose, rise,past+fin,_) . 
verb_form (risen, rise, past+oart , __) . 
verb_form (borders, border, pres+fin, 3+sin) . 
verb_form (bordering, border, pres+part, _) . 
verb_form (contains, contain, pres+f in,  3+sin)  . 
verb_form (containing, contain, pres+part ,  _) . 
verb_form (drains, drain, pres+fin, 3+sin) . 
verb_form (draining, drain, pres+part , _) . 
verb_form (exceeds, exceed, pres+f in, 3+sin) . 
verb_form (exceeding, exceed, pres+part ,_) . 
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chat_parser . m 


verb_type (have, aux+have) . 
verb_cype (be, aux+be) . 
varb_type (do, aux+ditrans) . 
verb_type (rise,  main+intrans)  . 
verb_type (border, main+trans) . 
verb_type (contain, main+trans) 
verb_type (drain, main+intrans) 
verb_type (exceed, main+trans) . 
verb_type ( flow, main+intrans)  . 

adverb (yesterday)  . 
adverb (tomorrow) . 
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.  chat_parser .bench 


*  /* 

set-up . chat_parser :  bench  set-up  for  chat_parser 
*/ 

chat_parser  :-  dr iver (chat_parser ) . 

benchmark (chat_parser,  run_chat_parser,  run_dummy,  10). 

run_chat_parser  :-  string(X), 

determinate_say (X,  _)  , 
f  ail . 

run_chat_parser . 

run_dummy  :-  string (X), 
dummy  (X,  _)  , 
fail . 

run_dummy . 

show (chat_parser)  ;-  string (X), 

write (X) ,  nl, 
determinate_say  (X,  Y)  , 
write  (Y)  ,  nl,  nl, 
fail . 

show (chat_parser) . 


#include  "driver" 
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fft 


f ft_4 .m  . 

f ft_8 .m  . 

fft  . 

. f ft_4 .bench 
.fft  8. bench 


fft  4.m 


fft_4.m:  benchmark  (fft)  fft_4  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option  (s):  $_OPTIONS_$ 

% 

%  fft_4 
% 

%  Richard  A.  O'Keefe 
% 

%  FFT  (fast  fourier  transform)  of  f(x)  =  x  on  2  4  points 


#if  BENCH 

#  include  " . fft_4 .bench" 
#else 

fft_4  numlistd,  16,  Raw) 
fwd_fft(Raw,  _) . 

#endif 


%  16  is  2*4 


numlist (I,  N,  ( ] ) 

I  >  N,  !  . 

numlistd,  N,  [I|L]) 

I  =<  N,  J  is  1+1, 
numlist  (J,  N,  L)  . 


#include  "fft" 


/*  code  for  N-point  FFT  */ 


fft*l 


fft  8.m 


*  /* 

fft_8.m:  benchmark  (fft)  fft_8  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s):  S _ OPTIONS _ S 

% 

%  f ft_8 

% 

%  Richard  A.  O'Keefe 

% 

%  FFT  (fast  fourier  transform)  of  f(x)  =  x  on  2"8  points 
#if  BENCH 

#  include  fft_8 .bench" 

(felse 

fft_8  numlistd,  256,  Raw),  %  256  is  2"8 
fwd_fft (Raw,  _) . 

Oendif 

numlist (I,  N,  [ ] ) 

I  >  N,  !  . 

numlistd,  N,  [  1 1  L } ) 

I  =<  N,  J  is  1+1, 
numlist  (J,  N,  L)  . 

((include  "fft"  /*  code  for  N-point  FFT  */ 


# 
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fft 


#  /* 

fft:  code  for  N-point  FFT 

*/ 

#option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (fwd_fft/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 


#if  DUMMY 
fwd_fft  (_,  _)  . 

#else 

%  This  is  a  Prolog  implementation  of  the  Fast  Fourier  Transform: 
% 

%  F(k;N)  =  sum[ j=0 . .N-l]  exp  (2  .  pi  .  i  .  j -k/N)  .  f(j) 

% 

% 

% 

% 

% 

% 

% 

% 

% 

% 


=  sum[ j=0 . -N/2-1]  exp (2 .pi . i .k. (2 j) /N)  .  f { 2 j ) 

+  sum( j=0 . .N/2-1]  exp (2 .pi . i .k. (2 j+1) /N)  .  f(2j+l) 

=  sum [ j=0. .N/2-1 ]  exp (2 -pi . i . j . k/ (N/2) )  .  f(2j) 

+  W“k  .  sum! j-0. .N/2-1]  exp (2  .pi . i . j .k/ (N/2) )  .  f (2  j  +  1) 

(where  W  =  exp (2 .pi . i/N) ] 

F  ( k ;  I )  -  F  ( k ;  E )  +  exp  (2 .  pi  .  i  .  k/ length  ( I!  )  .  F(k;Q) 


%  [where  evens_and_odds (I,  E,  0)1 
% 

%  It  stresses  floating-point  arithmetic.  Note  that  the  foreign 
%  function  interface  problem  is  avoided  by  using  a  table  of  the 
%  necessary  sines  and  cosines. 


fwd_fft(Raw,  FFT)  :- 

length (Ra ",  N)  , 

fft (N,  Raw,  FFT,  fwd)  . 

inv_f  ft  (FFT,  Raw)  :- 

length (FFT,  N) , 

fft (N,  FFT,  Mid,  inv) , 

scale (Mid,  N,  Raw). 

fftd,  [X],  [C],  _)  :-  !, 

complex_val (X,  C)  . 
fft  (N,  Raw,  FFT,  Dir)  :- 

n_cos_sin(N,  Cos,  Sin), 
pack_w(Dir,  Cos,  Sin,  W)  , 
M  is  N>> 1 , 

evens_and_odds (Raw,  E,  0) , 
f ft  (M,  E,  Ef,  Dir), 
fft (M,  0,  Of,  Dir), 


fft  (Ef, 

Of,  W, 

(1. 

0,0. 

0)  , 

z. 

FFT,  FF2), 

fft  (Ef, 

Of,  W, 

z. 

_,  FF2, 

m 

- 

pack 

w 

(fwd,  C, 

S,  (C,S) 

)  • 

pack 

w 

(inv,  C, 

S,  (C,Z) 

)  : 

-  Z 

is 

-s. 

fft  ( 

n 

,  N,  , 

Z,  Z,  F, 

F) 

. 

fft  ( 

[E 

lEs],  (01 

Os],  W, 

ZO, 

z. 

[FI 

Fs], 

FI)  :  - 

complex 

mul  (ZO, 

0, 

Zt) 

/ 

complex 

_add (Zt, 

E, 

F)  , 

complex 

_mul  (ZO, 

W, 

Zl) 

, 

fft (Es, 

Os,  W, 

Zl, 

z. 

F  s , 

FI) 

. 

fft  *3 


fft 


evens_and_odds  (  []  <  [),[])• 

evens_and_odds ( [E,  0  I EOs] ,  [ElEs],  [OlOs])  ^ 

evens  and  odds  (EOs,  Es,  Os). 


scale  ( [  J ,  (] )  . 

scale ( ( (Ra, la) IXs) ,  Scale,  [ (Rs, Is) I Ys] ) 

Rs  is  Ra/Scale, 

Is  is  Ia/Scale, 
scale (Xs,  Scale,  Ys)  . 

complex_val ( (Ra, la) ,  (Rs, Is) )  !, 

Rs  is  Ra*l .0, 

Is  is  Ia*1.0. 
complex_val (Ra,  (Rs, 0.0)) 

Rs  is  Ra*1.0. 

complex_add ( (Ra, la) ,  (Rb, lb) ,  (Rs,Is)) 

Rs  is  Ra+Rb,  £ 

Is  is  Ia+Ib. 


complex_mul ( (Ra, la) ,  (Rb, lb) ,  (Rs,Is)) 

Rs  is  Sa*Rb-Ia*Ib, 

Is  is  Ra*Ib+Rb*Ia. 

%complex_exp (Ang,  (Rs,Is)) 

%  cos (Ang,  Rs) , 

*  sin (Ang,  Is) . 

%  n_cos_sin(N,  C,  S)  N  is  2~ K  for  K=1..23, 


% 

C  is  cos (2 

■pi/N) , 

% 

S  is  sin (2. 

.pi/N) . 

n_cos_ sin ( 

2, 

-1.00000000, 

0 .00000000) . 

n_cos_sin ( 

4, 

0.00000000, 

1.00000000) . 

n_cos_sin ( 

8, 

0.707106781, 

0.707106781) . 

n_cos_sin ( 

16, 

0.923879533, 

0.382683432)  . 

n_cos_sin ( 

32, 

0.980785280. 

0.195090322)  . 

n_cos_sin ( 

64, 

0.995184727, 

0.0980171403) . 

n_c°s_sin ( 

128, 

0.998795456, 

0.0490676743) . 

n  cos— sin( 

256, 

0.999698819, 

0.0245412285) . 

n  cos_s in ( 

512, 

0.999924702, 

0.0122715383)  . 

n  cos_sin( 

1024, 

0.999981175, 

0.00613588465)  . 

n_cos_sin ( 

2048, 

0.999995294, 

0.00306795676) . 

n_cos_sin  ( 

4096, 

0.999998823, 

0.00153398019) . 

n_cos_sin ( 

8192, 

0.999999706, 

0.000766990319) . 

n_cos_sin ( 

16384, 

0.999999926, 

0.000383495188) . 

n  cos_sin ( 

32768, 

0.999999982, 

0.0001*1747597) . 

n  cos_sin ( 

65536, 

0.999999995, 

0.0000958737991) . 

n  cos_sin( 

131072, 

0.999999999, 

0.0000479368996) . 

n_cos_sin ( 

262144, 

1.00000000, 

0.0000239684498)  . 

n  cos  sin( 

524288, 

1.00000000, 

0.0000119842249) . 

n_cos_sin ( 

1048576, 

1.00000000, 

0.00000599211245) . 

n_cos  sin( 

2097152, 

1.00000000, 

0.00000299605623) . 

n  cos  3in( 

4194304, 

1.00000000, 

0.00000149802811)  . 

n_co3_sin ( 
#endif 

8388608, 

1.00000000, 

0.000000749014057)  . 

fft»4 


f ft  4 .bench 


#  /* 

set-up . fft_4 :  bench  set-up  for  (fft)  fft_4 
V 

fft_4  :-  driver ( f ft _ 4 )  . 

benchmark (fft_4,  fwd_fft (Raw,  _) ,  dummy(Raw,  _) ,  100)  :-  numlist(l,  16,  Raw). 

%  16  is  2*4 

(♦message  "NOTE:  show/1  is  NOT  defined  for  (fft)  fft  4" 


(♦include  "driver" 
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fft  8. bench 


#  /* 

set-up . fft_8 :  bench  set-up  for  (fft)  fft_8 
*/ 

fft_8  :-  driver ( f ft _ 8 )  . 

benchmark (fft_8,  fwd_fft (Raw,  _) ,  dummy (Raw,  _) ,  5) 


♦  message  "NOTE:  show/1  is  NOT  defined  for  fft_8'1 


numlist(l,  256, 
%  256  is  2*8 


Raw)  . 


♦include 


"driver 


II 
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boyer  .m 


#  /* 

boyer. m:  Gabriel  benchmark  boyer  master  file 

*/ 

%  generated:  _ MDAY _  _ MONTH _  _ YEAR _ 

%  option (s):  S _ OPTIONS _ $ 

% 

%  boyer 
% 

%  Evan  Tick  (from  Lisp  version  by  R.  P.  Gabriel) 

% 

%  November  1985 
% 

%  prove  arithmetic  theorem 
# if  BENCH 

#  include  " .boyer . bench" 

#else 

boyer  run_boyer. 

#endif 


loption  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (run_boyer/0) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected. 
#if  DUMMY 

run_boyer . 

#halt 

#endif 

run_boyer  wff(Wff), 

rewrite (Wff , NewWff )  , 
tautology (NewWff,  [],(]). 


wf  f  (  implies  (and  ( implies  (X,  Y)  , 

and ( implies (Y, Z) , 

and (implies (Z, U) , 

implies  (U,  W) ) )  )  , 
implies  (X,  W)  )  )  :  - 

X  =  f (plus (plus (a, b) , plus (c, zero) )) , 

Y  =  f (times (times (a, b) , plus (c, d) )) , 

Z  =  f (reverse (append (append  (a, b) ,[ ] ))) , 

U  =  equal (plus (a, b) , difference (x, y) ) , 

W  =  lessp (remainder (a, b) , member (a, length (b) )) . 

tautology (Wff ) 

write (' rewriting. . . ' ) , nl, 
rewrite  (Wff,  NewWff)  , 
write (’ proving. ..'), nl, 
tautology  (NewWff,  [] ,  [] )  . 

tautology (Wff, Tlist, Flist) 

(truep (Wf f , Tlist)  ->  true 
; falsep (Wff , Flist)  ->  fail 
;Wff  »  if (If, Then, Else)  -> 

(truepdf, Tlist)  ->  tautology  (Then,  Tlist ,  Flist ) 

; fa lsep (If , Flist )  ->  tautology (Else, Tlist , Flist ) 
/tautology (Then,  [ If  I Tlist J , Flist ) ,  i  both  must  hold 

tautology (Else, Tlist,  [ If  I Flist ] ) 

) 

)  .  !  . 


gabriel •  1 


boyer ,m 


rewrite (Atom, Atom) 

atomic (Atom) , ! . 
rewrite (Old, New) 

functor (Old, F, N) , 
functor  (Mid,  F,  N)  , 
rewrite_args (N, Old, Mid)  , 

(  equal (Mid, Next ) ,  %  should  be  ->,  but  is  compiler  smart 

rewrite (Next , New)  %  enough  to  generate  cut  for  ->  ? 

;  New=Mid 

)  ,  '  . 

rewr ite_args (0 , !. 
rewrite_args (N, Old, Mid) 

arg (N, Old, OldArg) , 
arg  (N,  Mid,  MidArg)  , 
rewrite (OldArg, MidArg) , 

N1  is  N-l, 

rewrite_args (Nl, Old, Mid) . 
t  ruep  (t ,  _)  :  -  !  . 

truep  (Wf  f ,  Tlist)  member  (Wff,  Hist)  . 
falsep (f ,  )  !  . 

falsep (Wf f , Flist)  member (Wff , Flist ) . 

member (X, (XI _] )  !. 

member  (X,  [  IT])  member(X,T). 


equal ( 
equal ( 
equal ( 

equal ( 
equal ( 
equal ( 

equal ( 

equal ( 

equal ( 

equal ( 

equal ( 
equal ( 


and (P, Q) , 

if  (P,  if  <Q,t,  f)  ,  f) 

)  . 

append (appendix, Y) , Z!  . 
append (X, append (Y, Z)  ) 

)  . 

assignment (X, append (A,  B) )  , 
if (assignedp (X, A) , 
assignment (X, A) , 
assignment (X, B) ) 

)  . 

assume_false (Var, A1 ist) , 
cons (cons (Var, f ) , Alist) 

)  . 

assume_true (Var, Alist) , 
cons (cons (Var, t) , Alist) 

)  . 

boolean  (X) , 

or  (equal  (X,t),equal(X,f!) 

)  . 

car  (gopher  (X)  )  , 
if (listp (X) , 
car (flatten (X) ) , 
zero) 

compile  (Form)  , 

reverse (codegen (optimize (Form! , [ ] ) ) 
)  . 

count_list (Z,sort_lp(X,Y)), 
plus (count_list (Z, X) , 
count_list (Z, Y) ) 

)  • 

countps_(L, Pred) , 
countps_loop (L, Pred, zero) 

)  . 

difference  (A,  B)  , 

C 

)  di f f erence ( A, B,  C )  . 

divides  (X,  Y)  , 

zerop ( rema inder ( Y, X) ) 

)  . 
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equal ( 
equal  ( 
equal ( 
equal ( 
equal ( 
equal ( 
equal ( 
equal ( 
equal ( 
equal ( 

equal ( 
equal ( 
equal ( 
equal ( 
equal ( 
equa  1  ( 
equal  ( 
equa 1 ( 
equal ( 

equal ( 

equa i ( 


dsort (X) , 
sort2 (X) 

)  . 

eqp(X,  Y), 

equal (fix(X) , f  ix  ( Y)  ) 

)  . 

equal (A, 3) , 

)  :  -  eq  (A,  3,  C)  . 

evenl (X) , 

if  (zerop  (X)  ,  t,  odd  (deer  (X)  > ) 

>  . 

exec  (append  (X,  Y)  ,  Pds,  Envrn)  , 
exec(Y,exec(X,Pds, Envrn)  ,  Envrn) 
)  . 

exp  (A,  B)  , 

C 

)  exp  (A,  3,0  . 
f  act_  ( I)  , 
fact_loop  (1,1) 

)  . 

falsify (X) , 

falsifyl (normalize (X) , (]) 

)  - 

fix (X) , 

if (numberp (X) , X, zero) 

)  . 

flatten (edr (gopher (X) ) ) , 
if (1 istp (X) , 

edr (flatten (X) ) , 
cons (zero, [ ] ) ) 

)  . 

ged (A, B) , 

C 

)  ged (A, B, C)  . 

get ( J,  set (I, Val, Mem) ) . 

if  (eqo  (J, : ,  ,  Val,  get  (u ,  Mem)  ) 

)  . 

greatereqp  (X,  Y)  , 
not  ( lessp  (X,  Y)  ) 

)  . 

greatereqpr (X, Y) , 
not ( lessp (X, Y) ) 

)  . 

greaterp (X, Y) , 
lessp  ( Y,  X) 

)  . 

if (if (A, B, C) , D,  E)  , 

if  (A,  if  (B,  D,  E)  ,  if  (C,  D,  E)  ) 

)  . 

iff (X, Y) , 

and  (impl  ies  (X,  Y)  ,  implies  ( Y,  X)  ) 

)  . 

implies  (P,  Q)  , 
if  (P.  if  (0,  t,  f)  ,  t) 

)  . 

last (append (A, 3) ) , 
if ( ) istp (B) , 

' ast (B) , 
if  ( 1  istp  (A)  , 

cons (car (last (A) ) ) , 

B)  ) 

1  . 

length (A) , 

B 

)  :  -  my  length  ( A,  B)  . 

.esseap (X, Y) , 
not ( lessp ( Y, X) ) 

)  . 
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equal ( 

equal ( 

equal ( 

equal ( 

equal ( 

equal ( 

equal ( 

equal ( 

equal ( 

equal ( 

equal ( 

equal ( 

equal ( 

equal ( 

equal ( 

equal  ( 

equal  ( 

equal ( 

equal ( 

equal ( 

equal ( 

equal ; 
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lessp  ( A, B)  , 

C 

)  : -  lessp (A, B, C) . 

listp (gopher (X) ) , 
listp (X) 

)  . 

mc_f latten (X, Y) , 
append (flatten (X) , Y) 

)  . 

meaning (A, B) , 

C 

)  meaning (A, 3, C) . 

member (A, B) , 

C 

)  mymember  (A,  B,  C)  . 

not  (P)  , 
if  (P,  f ,  t) 

)  - 

nth (A, B) , 

C 

)  nth ( A, B, C)  . 

numberp (greatest_factor (X, Y) ) , 
not  (and  (or  (zerop  ( Y)  ,  equal  (Y,  1)  )  , 
not (numberp (X) ) ) ) 

)  . 

or  (P,  Q)  , 

if  (P,t,  if  (Q,  t,  f)  ,  f) 

)  - 

plus (A, B) , 

C 

)  : -  plus (A, B, C)  . 

power_eval (A, B) , 

C 

)  power  eval  (A,  B,  C)  . 
prime (X) , 

and  (not  (zerop  (X)  )  , 

and (not (equal (X, addl (zero) ) ) , 
pr  imel  (X,  deer  (X)  )  )  ) 

)  . 

prime_list (append (X, Y) )  , 

and  <prime_list (X) ,prime_list (Y) ) 

)  . 

quotient (A, B) , 

C 

)  quotient (A, B, C)  . 
remainder (A, B)  , 

C 

)  remainder (A, B, C) . 

reverse_(X)  , 
reverse_loop (X, []) 

)  . 

reverse (append (A, B) ) , 
append ( reverse (B) , reverse (A)  ) 

)  . 

reverse_loop (A,  B)  , 

C 

)  reverse_loop (A,  B,  C)  . 

samef ringe (X, Y) , 

equal (flatten(X)  ,  flatten (Y) ) 

)  . 

sigma (zero, I) , 

quotient  (times  (I,  addl  (I)  )  ,  2) 

)  . 

sort2 (delete (X, L) ) , 
delete  (X,  sort2  (L)  ) 

)  . 

tautology _checker (X) , 
tautologyp (normalize (X) , (]) 

)  . 
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equal ( 


equal  ( 


equal ( 


equal ( 


times  (A,  3)  , 

C 

)  : -  t imes (A, B, C)  . 

times_list (append (X, Y) ) , 
times (times_list (X) , times_list (Y) ) 
)  . 

value (normalize (X) , A) , 
value (X, A) 

)  . 

zerop (X) , 

or  (equal  (X,  zero)  ,  not  (numberp  (X)  )  ! 

)  . 


difference (X,  X,  zero)  !. 
difference (plus (X, Y) ,  X,  fix(Y))  !. 
difference (plus (Y, X) ,  X,  fix(Y))  !. 

difference (plus (X, Y) ,  plus(X,Z),  difference (Y, Z) )  !. 

difference (plus (B, plus (A, C) ) ,  A,  plus(B,C))  !. 
difference  (addl  (plus  (Y,  Z)  )  ,  Z,  addl(Y)) 
difference (addl (addl (X) ) ,  2,  fix(X)). 


eq  (plus  ( A,  B)  ,  zero,  and  (zerop  (A)  ,  zerop  (B)  )  )  !. 

eq (plus (A, B) ,  plus (A,C) ,  equal (fix (B) , fix(C) ) )  !. 

eq(zero,  difference  (X,  Y)  ,  not  (lessp  (Y,  X)  )  )  !. 

eq  (X,  difference  (X,  Y)  ,  and  (numberp  (X) , 

and  (or  (equal  (X,  zero)  , 

zerop  (Y)  )  )  )  )  !  . 

eq  (times  (X,  Y)  ,  zero,  or  (zerop  (X)  ,  zerop  (Y)  )  )  !. 

eq  (append  (A,  B)  ,  append  (A,  C)  ,  equal  (B,C))  !. 

eq ( flatten (X) ,  cons (Y, (]),  and (nlistp (X) , equal (X, Y) ) )  !. 

eq  (great  est_f  act  or  (X,  Y)  .zero,  and  (or  (zerop  (Y)  .equal  (Y,  1)  )  , 

equal (X, zero) ) )  t-  !. 

eq(greatest_f actor ( X, _ ) , 1,  equal (X,l))  !. 

eq(Z,  times  (W,Z),  and  (numberp  (Z)  , 

or  (equal  (Z,  zero)  , 

equal (W, 1) ) ) )  !  . 

eq  (X,  times  (X,Y),  or  (equal  (X,  zero)  , 

and (numberp (X) , equal (Y, 1) )) )  !. 

eq ( t imes ( A, B) ,  1,  and (not (equal (A, zero) ) , 

and  (not  (equal  (B,  zero!  )  , 
and (numberp (A) , 

and (numberp (B) , 

and (equal (deer (A) , zero) , 

equal  (deer  (B)  ,  zero)  )))))  )  s- 
eq  (difference  (X,  Y)  ,  di  f  ference  (Z ,  Y)  ,  i  f  ( lessp  (X,  Y)  , 

not ( lessp ( Y, Z) ) , 
if ( lessp (Z, Y) , 

not  ( lessp  ( Y,  X)  )  , 
equal  (fix(X)  ,fix(Z)  )  )  )  ) 


eq ( lessp (X, Y) ,  Z,  i f ( lessp (X, Y) , 
equal  (t,  Z) , 
equal ( f , Z ) ) ) . 


expd,  plus(J,K),  t  imes  (exp  ( I,  J)  ,  exp  ( I,  K)  )  >  !. 

exp(I,  times(J.K),  exp  (exp  (I,  J) ,  K) )  . 


ged  (X,  Y,  ged  ( Y,  X)  )  !. 

ged  (times  (X,  Z)  ,  times(Y.Z),  t  imes  (Z,  ged  (X,  Y)  ))  . 
mylength (reverse (X) , length (X) ) . 

mylength (cons (_, cons (_, cons (_, cons (_,  cons (_,  cons (_,  X7 >>))>), 
plus (6, length (Xl) ) ) . 

lessp (remainder (_, Y) ,  Y,  not (zerop (Y) ) ) 
lessp (quot ient (I, J) ,  I,  and (not (zerop (I) ) , 

or  (zerop  ( J)  , 

not  (equal (J, 1) ))) )  !. 
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lessp  (  remainder  (X,  Y)  ,  X,  and (not (zerop (Y) ) , 

and (not (zerop (X) ) , 

not ( lessp (X, Y) ) ) ) )  !  . 

lessp (plus  (X,  Y)  ,  plus(X,Z),  iessp(Y,Z))  !. 
lessp  (times  (X,  Z)  ,  times(Y,Z),  and  (not  (zerop  (Z)  )  , 

lessp (X, Y) ) )  !. 

lessp(Y,  plus(X,Y),  not (zerop (X) ) )  !. 

lessp (length (delete (X, L) ) „  length (L) ,  member (X, L) ) . 

meaning (plus_tree (append (X, Y) ) , A, 

plus  (meaning  (plus_tree  (X)  ,  A) , 

meaning  (plus_tree  (Y)  ,  A)  )  )  !. 

meaning (plus_tree (plus_f ringe (X)  )  ,  A, 
fix (meaning (X, A) ) )  !. 

meaning  (plus_t  ree  (delete  (X,  Y)  )  ,  A, 
if  (member  (X,  Y)  , 

difference (meaning (plus_tree ( Y) ,  A) , 
meaning (X, A) ) , 
meaning  (plus_t  ree  ( Y)  ,  A)  ) )  . 

mymember  (X,  append  (A,  B)  ,  or  (member  (X,  A)  ,  member  (X,  B)  )  )  !. 

mymember  (X,  reverse  (Y)  ,  member  (X,  Y)  )  !. 

mymember (A, intersect (B,  C) , and (member (A,  B) , member (A,  C) ) )  . 

nth  (zero,  zero)  . 

nth  ( [] ,  I,  if  (zerop (X)  ,  ,  zero) )  . 

nth  (append  (A,  B)  ,  I,  append  (nth  (A,  I)  ,  nth  (B,  difference  (I,  length  (A)  )  )  )  )  . 

plus  (plus  (X,  Y)  ,  Z, 

plus(X,plus(Y,Z)  )  )  !. 

plus  (remainder  (X,  Y)  , 

times (Y, quotient (X, Y) ) , 
fix (X) )  ! . 

plus  (X,  addl  (Y)  , 

if  (numberp  (YJ  , 

addl  (plus  (X,Y)  )  , 
addl (X) ) ) . 

power_eval (big_plusl (L, I, Base) , Base, 

plus  (power_eval  (L,  Base)  ,  I)  )  !. 

power_eval (power_rep ( I, Base) , Base, 
fix (X) )  !. 

power_eval (big_plus (X,Y, I, Base) .Base, 

plus (I,  plus (power_eval (X, Base) , 

power_eval (Y, Base) ) ) )  !. 

power_eval (big^plus (power_rep ( I, Base! , 
power_rep ( J, Base) , 
zero. 

Base) , 

Base, 

plus (I, J) )  . 

quotient (plus (X, plus (X, Y) ) ,2, plus (X, quotient (Y, 2) ) )  . 
quotient (times ( Y, X) , Y, if (zerop (Y) , zero, fix (X) ) ) . 

remainder 
remainder 
remainder 
remainder 

reverse_loop (X, Y,  append (reverse (X) , Y) )  !. 

reverse_loop (X, ( ] ,  reverse(X)  ). 

times  (X,  plus(Y,Z),  plus  (t  imes  (X,  Y)  ,  times  (X,  Z )  )  ) 

times  (times  (X,  Y)  ,  Z,  t  imes  (X,  t  imes  (Y,  Z)  )  ) 

t  imes  (X,  difference  (C,  W)  ,  difference  (times  (C,  X)  ,  times  (W,  X)  )  ) 

times  (X,  addl  (Y)  ,  if  (numberp  (Y)  , 

plus  (X,  t  imes  (X,  Y)  )  , 
f ix (X) )  ). 


(_,  1,  zero)  !  . 

(X,  X,  zero)  !. 

(times  (_,  Z)  ,  Z,  zero)  . 

(times  ( Y,  )  ,  Y,  zero)  . 
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♦  /* 

browse. m:  Gabriel  benchmark  browse  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s) :  S _ OPTIONS _ S 

% 

%  browse 
% 

%  Tep  Dobry  (from  Lisp  version  by  R.  P.  Gabriel) 
% 

%  (modified  January  7987  by  Nerve'  Touati) 
tif  BENCH 

♦  include  " .browse .bench" 

♦else 

browse  run_browse . 

♦endif 


♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (run_browse/0) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 

♦if  DUMMY 

run_browse . 

♦  halt 

♦endif 

run_browse 

init (100, 10, 4, 

[  [a,  a,  a,b,b,  b,  b,  a,  a,  a,  a,  a,  b,b,  a,  a,  a] , 

[a,  a,  b,  b,  b,  b,  a,  a,  (a, a],  [b,b]], 

(a,  a,  a,  b,  (b,  a  ] ,  b,  a,  b,  a] 

], 

Symbols)  , 

randomize (Symbols,RSymbols, 21) , ! , 
investigate (RSymbols, 

(  (star  (SA)  ,  B,  star  (SB)  ,B,a,  star(SA)  , a, start  SB)  ,  star  (SA)  ] , 

(star (SA) , star (SB) , star (SB) , star (SA) , (star (SA) ] , [ star (SB) ] ] , 
(_,  ,  star  (_)  ,  [b,  a  J ,  star  (_) ,  _,  _] 

])  . 


init (N, M, Npats, Ipats, Result )  init (N, M, M, Npats , Ipats , Result ) . 

init  (0 !. 
init (N, I, M, Npats, Ipats, [SymbIRest]) 
filld,  C  ] ,  L) , 

get_pats (Npats, Ipats, Ppats)  , 

J  is  M  -  I, 

fill ( J , [pattern (Ppats) |L],Symb), 

HI  is  N  -  l, 

(I  =:=  0  ->  II  is  M;  II  is  I  -  1)  , 
init (Nl, II,  M, Npats, Ipats, Rest) . 

fill (0, L, L)  !. 
f ill (N, L,  [dummy ([])  I  Rest ] ) 

Nl  is  N  -  1, 
fill (Nl , L, Rest)  . 
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randomize ([],[ j ,_)  !. 

randomize ( In, [X | Out ], Rand) 
length (In, Lin) , 

Randl  is  (Rand  *  17)  mod  251, 

N  is  Randl  mod  Lin, 
split  (N,  In,  X,  Ini)  , 
randomize ( Ini, Out , Randl)  . 

split  (0,  iXIXs]  ,X,Xs)  !. 
split (N,  [X  I Xs] , RemovedElt,  { X  I Y s ] ) 

111  is  N  -  1, 

split (Nl, Xs, RemovedElt, Ys) . 

investigate ([ j ,_)  !. 

invest igate ( [U I  Units] , Patterns) 
property (U, pattern, Data) , 
p_investigate (Data, Patterns) , 
investigate (Units, Patterns) . 

get_pats (Npats, Ipats, Result)  get_pats (Npats, Ipats, Result, Ipats) . 

get_pats  (0,_,  [],_)  ■ 

get_pats (N, [XI Xs], [XIYs], Ipats)  : - 
Nl  is  N  -  1, 

get_pats (Nl, Xs, Ys, Ipats) . 
get_pats  (N,  [],  Ys,  Ipats) 

get_pats (N, Ipats, Ys, Ipats) . 

property ([],_, _)  fail.  /*  don't  really  need  this  */ 

property  (  [Prop  I _] , P,  Val) 
functor  (Prop,P,_) ,  !, 
arg(l.  Prop,  Val)  . 
property ( [_|RProps] ,P, Val) 
property (RProps.P, Val) . 

p_investigate  (  []  ,_)  . 

p_in vest igate ( [D | Data] .Patterns)  : - 
p_match  (Patterns,  D)  , 
p_investigate (Data, Patterns) . 

p_match  ((],_)  . 
p_match ( (P I  Patterns]  ,  D) 

(match (D, P ), fail;  true), 
p_match  (Patterns,  D)  . 

match  ([],[])  !  . 

match ( [XIPRest] ,  [ Y I SRest ] ) 
var  ( Y)  ,  ! ,  X  =  Y, 
match (PRest , SRest) . 
match (List,  [YIRest]) 

nonvar(Y)  ,Y  =  star(X),!, 
concat (X, SRest, List) , 
match (SRest, Rest) . 
match ([XI PRest ] , [Y I SRest ] )  : - 

(atom(X)  ->  X  =  Y;  match (X,Y)>, 
match  (PRest , SRest )  . 

concat ( ( ] , L, L)  . 

concat ( [XI  LI] , L2,  [XI L3] )  concat (LI, L2, L3)  . 
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*  /' 

poly_5.m:  Gabriel  benchmark  (frpoly)  poly_5  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s) :  S _ OPTIONS _ S 

% 

%  (frpoly)  poly_5 
% 

%  Rick  McGeer  (from  Lisp  version  by  R.  P.  Gabriel) 

% 

%  raise  a  polynomial  (1+x+y+z)  to  the  5th  power  (symbolically) 
#if  BENCH 

#  include  " .poly_5 .bench" 

((else 

poly_5  test_poly (P) ,  run_frpoly (5,  P),  !. 

itendif 


%  test  polynomial  definition 
test_poly(P) 

poly_add  (poly  (y,  [term  (1,  1)  ]  ) ,  poly  (x,  [term(0,  1)  ,  term  ( 1,  1)  ]  )  ,  Q)  , 
poly_add (poly (z, [term (1, 1) ] ) , Q, P) . 


((include  "frpoly"  /*  code  for  symbolic  polynomial  exponentiation  */ 
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#  /* 

poly_10.m:  Gabriel  benchmark  (frpoly)  poly_10  master  file 

V 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s) :  $ _ OPTIONS _ $ 

% 

%  (frpoly)  poly_10 
% 

%  Rick  McGeer  (from  Lisp  version  by  R.  P.  Gabriel) 

% 

%  raise  a  polynomial  (1+x+y+z)  to  the  10th  power  (symbolically) 
#if  BENCH 

#  include  “ .poly_10 .bench" 

((else 

poly_10  test_poly  (P)  ,  run_frpoly  (10,  P),  . 

(tendif 


%  test  polynomial  definition 
test_poly(P) 

poly_add(poly (y,  [term(l,  1)  ]  )  ,poly(x,  (term(0,  1)  ,term(l,  1)  ]  )  ,Q)  , 
poly_add (poly (z,  (termd,  1)  ]),Q,P)  . 


((include  '•frpoly"  /*  code  for  symbolic  polynomial  exponentiation  */ 
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#  /* 

poly_15.m:  Gabriel  benchmark  (frpoly)  poly_15  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _  _ YEAR _ 

%  option (s) :  S _ OPTIONS _ S 

% 

%  (frpoly)  poly_15 
% 

%  Rick  McGeer  (from  Lisp  version  by  R.  P.  Gabriel) 

% 

%  raise  a  polynomial  (1+x+y+z)  to  the  15th  power  (symbolically) 
#if  BENCH 

#  include  " .poly_15 .bench" 

♦  else 

poly_15  test_poly  (P)  ,  run_f  rpoiy  (15,  ?)  ,  . 

♦endif 


%  test  polynomial  definition 
test_poly(P) 

poly_add  (poly  (y,  [term  (1, 1)  ] ) ,  poly  (x,  !  term  (0,  1) ,  term  ( 1, 1)  ]  )  ,  Q)  , 
poly_add  (poly  (z,  [term  (1,  1)  ]  )  ,  Q,  P)  . 


♦include  "frpoly"  /*  code  for  symbolic  polynomial  exponentiation 
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*  /* 

frpoly:  Gabriel  code  for  symbolic  polynomial  exponentiation 

*/ 

%  polynomial  addition 

poly_add(  poly(Var,  Termsl) ,  poly(Var,  Terms2) ,  poly(Var,  Terms3)  ) 

I 

add_terms (Termsl,  Terms2,  Terms3). 

poly_add (  poly (Varl,  Termsl),  poly(Var2,  Terms2),  poly (Varl,  Terms3)  ) 

Var2  @>  Varl , 

I 

add_To_Zero_Term (Termsl,  poly(Var2,  Terms2) ,  Terms3  ). 

poly_add (  poly(Varl,  Termsl),  poly(Var2,  Terms2),  poly(Var2,  Terms3)  ) 

Varl  @>  Var2, 

add_To_Zero_Term(Terms2,  poly(Varl,  Termsl),  Terms3  ). 
poly_aad (  poly (Varl,  Termsl),  N,  poly (Varl,  Terms3)! 

I 

add_To_Zero_Term (Termsl,  N,  Terms3  ). 

poly_add(  N,  poly(Var2,  Terms2),  poly(Var2,  Terms3)) 

» 

•  / 

add_To_Zero_Term (Terms2,  N,  Terms3  ). 

%  plain  numerical  addition 

poly_add (N,  M,  T) 

T  is  N  +  M. 

%  term  addition 

add_terms  {  (] ,  X,  X)  !. 

add_terms  (X,  (] ,  X)  !. 

add_terms ( (term (Exp, Cl)  I Termsl] ,  [term (Exp, C2)  |Terms2] ,  (term (Exp, C)  I  Terms) ) 
;  § 

poly_add(Cl,  C2,  C)  , 

add_terms (Termsl,  Terms2,  Terms). 

add_terms  (  [term (El,  Cl)  I  Termsl] ,  (term(E2,C2)  ITerms2] ,  (term (El,  Cl)  I  Terms] )  : 

El  <  E2, 

r 

add_ter ms (Termsl,  (term(E2,C2)  I Terms2 ] , Terms)  . 

add_terms (Termsl,  lterm(E2,C2)  ITerms2],  (term(E2,C2)  ITerms]) 
add_terms (Termsl,  Terms2,  Terms). 

add_To_Zero_Term ( [ term( 0 , Cl) ITerms], C2, (term(0,C) (Terms]) 

i 

•  t 

poly_add(Cl,  C2,  C) . 

add  To  Zero  Term (Terms,  C,  (term(0,C)  ITerms])  . 


gabriel • 12 


frpoly 


%  run_frpoly  definition 
#opt ion  DUMMY  “ 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (run_frpoly/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
#if  DUMMY 

run_f rpoly (_,  _) . 

♦halt 

#endif 

run_frpoly (N,  P) 

poly_expt (N,  P,  _) . 


%  polynomial  multiplication 

poly_mult  (  poly(Var,  Termsl)  ,  poly(Var,  Terms2)  ,  poly(Var,  Terms3)  ) 
form_poly__product  (Termsl,  Terms2,  Terms3)  . 

poly_mult (  poly(Varl,  Termsl),  poly(Var2,  Terms2) ,  polytVarl,  Terms3)  ) 
Var2  @>  Varl, 

j 

multiply_through (Termsl,  poly(Var2,  Terms2),  Terms3  ). 
poly_mult (  Polyl,  poly(  Var2,  Terms2),  poly(Var2,  Terms3)  ) 

i 

•  t 

multiply_through (Terms2,  Polyl,  Terms3  ). 
poly_mult(  polyl  Var2,  Terms2),  Polyl,  poly(Var2,  Terms3)  ) 

t 

■  / 

multiply_through (Terms2,  Polyl,  Terms3  ). 

poly_mult (Cl,  C2,  C) 

C  is  Cl  *  C2 . 

mult iply_through ( [] ,  _,  ij)  !. 

mult iply_through ( [term (N, Tl)  I  Terms] ,  Poly,  (term(N, NewTl)  INewTerms] ) 
poly_mult (Tl,  Poly,  NewTl), 
mult iply_through (Terms,  Poly,  NewTerms) . 

form_poly_product ( [ J , _, [ ] )  !. 

form_poly_product  (_,(],[]  )  . 

form_poly_product ( (Tl [Terms] ,  Terms2,  Terms3) 
form_single_product (Terms2 ,  Tl,  Ta) , 
form_poly_product (Terms,  Terms2,  Tb) , 
add_terms (Ta,  Tb,  Terms3) . 

form_single_product ( [] , _, (] )  !. 

form_singie_product ( (term (Expl, Cl)  I  Terms] , 
term (Exp2, C2) , 

(term(Exp,C)  IProducts]) 

Exp  is  Expl  +  Exp2, 
poly_mult  (Cl,  C2,  C)  , 

form_single_product (Terms,  term (Exp2, C2) ,  Products). 
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%  polynomial  exponentiation 

poly_expt(0,  _,  1) 

poly_expt (N,  P,  Result) 
evenP  (N)  , 

i 

M  is  N  //  2, 

poly_expt (M,  P,  NextRes), 
poly_mult  (NextRes,  NextRes,  Result), 

poly_expt (N,  P,  Result) 

M  is  N  -  1, 

poly_expt (M,  P,  NextRes), 
poly_mult  (P,  NextRes,  Result). 


%?cly_expt  'N,  P,  Result) 

%  poly_expt(  N,  P,  1,  Result). 

% 

%poly_expt  (0 ,  _,  Result,  Result)  !. 

% 

%poly_expt (N,  P,  ResSoFar,  Result) 

%  evenP  (N)  , 

%  !, 

%  M  is  N  //  2, 

%  poly_mult  (ResSoFar,  ResSoE’ar,  NextRes)  , 
%  poly_expt (M,  P,  NextRes,  Result). 

% 

%poly_expt (N,  P,  ResSoFar,  Result) 

%  M  is  N  -  1, 

%  poly_mult  (P,  ResSoFar,  NextRes)  , 

%  poly_expt (M,  P,  NextRes,  Result). 


evenP (X) 

N  is  X  //  2, 
X  is  N  *  2. 
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*  /* 


%  polynomial  writing 

print_poly (poly ( Var,  Terms)) 

! 

print^Terms  (Terms,  Var). 

print_poly (X) 
write (X) . 

prir.t_Terms  ( [ ) ,  _)  !• 

print_Terms ( ( term (_,  0) ITermsJ,Var) 
! 

•  t 

p’-int  Terms (Terms,  Var). 

print_Terms  (  [Term]  ,  Var) 

print_Term  (Term,  Var). 

print_Terms ( [Terml Terms ],  Var) 
print_Term (Term,  Var), 
write('  +  '), 
print  Terms  (Terms,  Var). 

print_Term ( term (0,  P)  ,  _) 

I 

print_poly (P) . 
print_Term  (term  (1,  C)  ,  Var) 

t 

print_Coeff  < C )  , 
write (Var) . 

print_Terjn  (term  (Exp,  C)  ,  Var) 
print_Coef  f  (C)  , 
write  (Var)  , 
write  ('“'), 
write (Exp)  . 

print_Coef f (1)  !. 

print_toef f (N) 
atomic  (N)  , 

•  » 

write  (N)  , 
write  ( ' *'  )  . 

print_Coef  f  (P)  :~ 

( 

•  t 

write ( ' ( ' ) , 
print_poly  (P)  , 
write (')'), 
write  (' *' )  . 

*/ 
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♦  /  * 

puzzle. m:  Gabriel  benchmark  puzzle  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s):  $ _ OPTIONS _ S 

% 

%  puzzle 
% 

%  Evan  Tick  (from  Lisp  version  by  R.  ?.  Gabriel) 

*if  BENCH 

#  include  puzz le . bench" 

4e  I  se 

♦option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  snow  what  the  benchmark  aoes.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/l." 

#  if  SHOW 

puzzle  make_board (Board)  , 

initialize (Board, Pieces)  , 
play (Board, Pieces) ,  !, 

acces: (0,  N) , 

write  (' success  in  '),  write(N),  write!'  trials'),  nl. 

#  else 

puzzle  make_board (Board) , 

initialize (Board, Pieces) , 
play  (Board, Pieces)  ,  !. 

#  endif 
#endif 

make_board (LevelO) 

make_level  (LevelO-Levell,  Levell-_)  , 
make_level (Levell-Level2, Level2-_) , 
make_level (Level2-Level3, Level3-_) , 
make_level  (Level3-Level4,  Level4-_)  , 
make_ievel (Level4- [ ] , X— [ ] ) , 

X  =  [z,z,z,z,z,  z,z,z,z,z,  z,z,z,z,z,  z,z,z,z,z,  z,z,z,z,z]. 

make_level (C-Link, Z-L) 

C  =  [C00,C10,C20,C30,C40, 

C01,C11,C21,C31,C41, 

C02,C12,C22,C32,C42, 

C03,C13,C23,C33,C43, 

C04,C14,C24,C34,C44  I  Link), 

Z  =  (ZOO,Z10,Z20,Z30,Z40, 

Z01,Z11,Z21,Z31,Z41, 

Z02, Z12, Z22, Z32, Z42, 

Z03,Z13,Z23,Z33,Z43, 

U  v  *t  ,  611  f  L><-' if  4(0*1, 0-11  I  ij  j  , 


coo 

= 

S 

, CIO, C01, ZOO) 

CIO 

= 

s 

,  C20,  Cll,  Z10) 

C20 

= 

s 

,C30,C21,Z20) 

C30 

= 

s 

, C40, C31, Z30) 

C40 

= 

s 

(_,  z,  C4  i,  Z40) 

C01 

= 

s 

,C11,C02,Z01) 

Cll 

= 

s 

,C21,C12,ZU) 

C21 

= 

s 

,C31,C22,Z21) 

C31 

= 

s 

,C41,C32,Z31) 

C41 

= 

s 

,  z, C42 , Z4 1 ) 
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puzzle .m 


C02 

= 

s(_ 

,  C12, C03 , Z02 )  , 

C12 

= 

s  ( 

,  C22, C13, Z12) , 

C22 

= 

s(_ 

, C32,  C23 , 222 )  , 

C32 

s  (_ 

,  C42, C33, Z32) , 

C42 

= 

s 

,  z,  C43 ,  Z42 )  , 

C03 

= 

s 

,C13,C04,Z03)  , 

C13 

= 

s  (- 

,  C23,C14,Z13)  , 

C23 

= 

S  (_ 

, C33,  C24 ,  Z23)  , 

C33 

= 

s  L 

,C43,C34,Z33)  , 

C43 

= 

s  L 

,  z,  C44,  Z43)  , 

C04 

- 

s  ( 

,  C14 ,  z , Z0 4 )  , 

C14 

= 

s(“ 

, C24 ,  z , Z14 ) , 

C2  4 

- 

s  C 

, C34 ,  z , Z24 ) , 

C34 

= 

s  (_ 

, C4  4 ,  z , Z3  4 ) , 

C44 

= 

s  ( 

,  z,  z ,  24 4 )  . 

initialize  (  [Spot  |_] ,  [[b,c,d,e,f,g,h,i,j,)c,l,m],  [n, o,  p] ,  !q] ,  C  r  ]  1 ) 
set  (0,0), 
pi (a, Spot)  . 

#option  " 

>  puzzle  uses  set/2  and  access/2.  If  one  of 

> 

>  C_PL  QUINTUS_PL 

> 

>  is  selected,  then  set/1  and  access/1  are  defined  using 

>  assert/1  and  retract/1.  If  the  Prolog  system  does  not 

>  offer  set/1  and  access/1  (as  built-ins)  but  does  offer 

>  assert/1  and  retract/1,  then  you  may  add  an  option  for 

>  the  Prolog  system  to  the  list  above.” 

#if  C_PL  I  I  QCJINTUS_PL 

set  (N,  A) 

(retract  ('  Sset'  (N,  _)  )  ;  true), 
assert  (' Sset'  <N,  A)),  !. 

access (N,  A)  :- 

'  Sset'  (N,  A) ,  !  . 

#else 

#  message  "WARNING:  set/2  and  access/2  must  be  defined." 

#endif 
%  4-2-1 

pi  (M,  s  (M,  s(M,  s  (M,  s  (M,_,C13,_)  ,  C12 ,_),  Cll ,_),  s  (M,  Cll ,_,_),_)  ) 

C13  =  s(M,  _,_,_)  , 

C12  =  s  (M,C13,_,_) , 

Cll  =  s(M,C12,_,_)  . 

%  2-1-4 

pi  (M,  s  (M,  s  (M,  Cll )  ,_,  s(M,Cll,_,  s  (M,  C12,_,  s  (M,  C13, _,  _)  )  )  )  )  :- 

C13  =  s  (M ,_,_,_)  , 

C12  =  s  (M,_,_,C13)  , 

Cll  =  s  (M,_,_,C12)  . 

%  1-4-2 

pi  (M,  s  (M,  _,  s(M,_,  s  (M, s  <M,_,_,C13)  ,C12)  ,  Cll)  ,  s  (M,_, Cl  1,  _)  )  )  :- 

C13  »  s(M, _,_,_)  , 

C12  =  s  (M,_,C13,_)  , 

Cll  -  s(M,_,Cl2,_)  . 

%  2-4-1 

pi  (M,  s  (M,  s  (M, _,  Cll ,  _)  ,  s  (M,  Cll,  s  (M,  C12,  s  (M, C13,  _, _> , _)  ,_),_)) 

C13  =  s  (M,  _,_,_)  , 

C12  =  s(M,_,Cl3,_)  , 

Cll  =  s  (M,_,C12,_)  . 

%  4-1-2 

pi  (M,  s  (M,  s  (M,  s  (M,  s  (M,_,_,C13)  ,_,C12)  , _,  Cl  1 )  ,  _,  s  (M,  Cll,  _,  _)  )  )  :- 
C13  =  s  (M,  _,_,_)  , 

C12  =  s  (M,C13,  _,_)  , 

Cll  =  s (M,  C12, _,  _)  . 
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%  1-2-4 


1,  , 

s  (M,  , 

,C11)  ,  s  (M 

C13 

=  s  (M^ 

,  ,  )  , 

C12 

=  s  ;m, 

-  ,  , Cl  3 ) , 

Cll 

=  s  (M, 

,  , C12 ) . 

(♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (play/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
*if  DUMMY 

play  . 

#halt 

(♦endif 

play (Board, Pieces)  play (Board, Pieces, Board) . 


Play  (  [],_,_)  . 

play ( [s (V, _,_, _) IRest] ,Pieces, Board) 
nonvar(V),  !, 
play (Rest , P ieces, Board) . 

play ( (Spot IRest] .Pieces,  Board)  • - 

fill (Spot, Pieces, NewP ieces)  , 
incr, 

play (Rest, NewP ieces.  Board)  . 

incr  access (0,  Count), 

NCount  is  Count  +  1, 
set(0,  NCount). 

fill  (Spot,  (  (Mark  I P 1  ]  IT]  ,  [PUT]  )  pi  (Mark,  Spot)  . 

fill (Spot,  [PI,  [Mark |P2]  IT] ,  [P1,P2 IT] )  p2 (Mark, Spot) . 

fill (Spot,  [P1,P2,  [MarklP3]  IT],  [P1,P2,P3  IT] )  :-  p3 (Mark, Spot) . 

fill (Spot,  [PI,  P2, P3,  [Mark  I P  4 ]  IT],  [P1,P2,  ?3,  P4 l T] )  p4 (Mark,  Spot)  . 

p2(M,  s(M,  s(M,  s(M,  _,_,_),  ,_),_,_))  . 

p2(M,  s(M,_,  s(M,_,s(M,_,_7_),_)  ,_)  )  . 

p2  (M,  s  (M,  _,  _,  s  s  (M,_,_,  _)))). 

p3  (M,  s  (M,  s  (M,_,C,_)  ,  s  !M,C,_,_) ,_) )  :- 
C  =  s  (M,_,_,  J  . 

p3  (M,  s  (M,  s  (M,  ,_,C)  s  (M,C,_,_) )  )  :- 
C  =  s  (M,  _,_,_)  . 

p3  (M,  s  (M,_,  s(M,_,_,C)  ,s(M,_,C,_)  )  ) 

C  =  s  (M,  _,_,_)  . 

p4  (M,  s  (M,  s  (M,  _,  C110,  C101)  ,  s  (M.C110,  ,  s  (M,  Cll  1 ,_,_)),  s  (M,  CIO  1,  C01 1 ,  )  )  ) 
C110  =  s (M, Clll) , 

C101  =  s  (M,  _,  Cl  11,_)  , 

C011  =  s (M, Clll, _,_) , 

Clll  =  s(M,  ,  ,  ) . 
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♦  /* 

tak.m:  Gabriel  benchmark  tak  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _  _ YEAR _ 

%  option  (s):  $_OPTIONS _ S 

% 

%  tak 
% 

%  Evan  Tick  (from  Lisp  version  by  R.  P.  Gabriel) 

% 

%  (almost)  Takeucbi  function  (recursive  arithmetic) 

♦if  BENCH 

♦  include  ".tak. bench" 

♦  else 

♦option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

♦  if  SHOW 

tak  tak  (18, 12,  6,  A)  ,  write  (' tak  (18  12  6)  =  '),  write(A),  nl. 

♦  else 

tak  tak (18,  12, 6, _) . 

♦  endif 
♦endif 

♦option  DUMMY  “ 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  fo" 

>  the  benchmark  execution  predicate  (tak/4) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
♦if  DUMMY 

tak  • 

♦halt 

♦endif 

tak  (X,  Y,  Z ,  A) 

X  =<  Y,  !  , 

Z  »  A. 

tak  (X,  Y,  Z,  A)  :  - 

XI  is  X  -  1, 
tak  (XI,  Y,  Z,  Al)  , 

Y1  is  Y  -  1, 
tak  (Yl,  Z,X,  A2)  , 

Z1  is  Z  -  1, 
tak  (21,  X,  Y,  A3)  , 
tak  ( Al ,  A2 ,  A3 ,  A)  . 
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*  /» 

set-up .boyer :  bench  set-up  for  boyer 
*/ 

boyer  :-  driver  (boyer)  . 

benchmark (boyer,  run_boyer,  dummy,  1). 

# message  "NOTE:  show/1  is  NOT  defined  for  boyer" 

♦include  "driver" 
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browse .bench 


#  /* 

set-up . browse :  bench  set-up  for  browse 

*/ 

browse  driver (browse)  . 

benchmark (browse,  run_browse,  dummy,  1). 

# message  "NOTE:  show/1  is  NOT  defined  for  browse" 


♦include  "driver" 
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•Poly_5 .bench 


#  /* 

set-up . poly_5 :  bench  set-up  for  (frpoly)  poly_5 

#  */ 

poly_5  :-  dr iver (poly_5) . 

benchma-k (poly_5,  (run_f rpoly (5,  P) ,  !),  (dummy (5,  P,,  !) 

test_poly (P) . 

# message  "NOTE:  show/1  is  NOT  defined  for  (frpoly)  poly_5 


((include 


"driver" 


,  200) 
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.poly_10 .bench 


*  /* 

sec-up. poly_10:  bench  set-up  for  (frpoly)  poiy_10 

*/ 

poly_10  :-  driver (poly_10) . 

benchmark (poly_10,  (run_f rpoly (10,  P),  !),  (dummy (10,  P)  ,  !),  15) 

test_poly (P) . 

♦message  "NOTE:  show/1  is  NOT  defined  for  (frpoly)  poly_10" 


♦include  "driver" 
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.poly_15 .bench 


*  /  * 

set-up. poly_15:  bench  set-up  for  (frpoiy)  poly_15 
*/ 

poly_15  :-  driver (poly_15) . 

benchmark (poly_15,  (run_frpoly (15,  P),  !),  (dummy(15,  P), 

test_poly (P ) . 

♦message  "NOTE:  show/1  is  NOT  defined  for  (frpoiy)  poly_15 


(include  "driver" 
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*  /* 

set-up . puzz le :  bench  sec-up 

*/ 

puzzle  :-  driver (puzzle)  . 


for  puzz le 


benchmark (puzzle,  (play(Board,  Pieces),  !),  (dummy (Board,  Pieces),  !),  5)  :- 

make_board (Board) , 
initialize (Board,  Pieces). 


show (puzzle) 


make_board (Board) , 
initialize (Board,  Pieces), 
play (Board,  Pieces),  !, 
access  (0,  N) , 

wr  ite  (' success  in  '),  write  (N), 


write  ('  trials'  )  , 


nl . 


*include  "driver" 
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4  /* 

sec -up .  t  a* :  bench  set-up  for  ra.< 

V 

tak  : -  driver(tak). 

oenchmark ( tak,  tak  ( 18, 12,  6, _) ,  dummy ( 1 8, 12 ,  6,  _)  ,  1C). 
snow(tak)  tak (18, 12, 6, A) ,  write (' tak ( 18  -2  6)  =  '), 


wr i te (A) , 


♦include  “driver 


gabriel *26 


n  1 . 


[lisp]  README 


;  rile  jabriei/Ltsp/README 

;  Upd.r  3  February  1989 

;  Mode:  LISP;  Package :  COMMON- LISP -USER;  Syntax:  Common-Lisp 

;  These  files  contain  common  lisp  versions  of  the  lisp  performance 
;  benchmarks  from  Stanford.  They  were  translated  and  tested  using 
;  Symbolics  Common  Lisp  on  a  Symbolics  3600.  They  have  not  been 
;  "tuned"  to  any  particular  implementation.  There  is  no  Common 
;  Lisp  timing  function  -  these  are  highly  system  dependent. 

;  See  R.  P.  Gabriel,  "Performance  and  Evaluation  of  Lisp  Systems," 
;  MIT  Press,  Cambridge,  Massachusetts,  1935. 
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[lisp]  boyer.l 


; ; ;  BOYER 

;;;  Logic  programming  benchmark.,  originally  written  by  Bob  Boyer. 
;;;  Fairly  CONS  intensive. 

;;;  run  (setup),  then  call:  (test) 

(ciefvar  unify-subst) 

(defvar  temp-temp) 

(defun  add-lemma  (term) 

(cond  ( (and  (not  (atom  term) ) 

(eq  (car  term) 

(quote  equal ) ) 

(not  (atom  (cidr  term)))) 

(setf  (get  (car  (cadr  term))  (quote  lemmas)) 

(cons  term  (get  (car  (cadr  term))  (quote  lemmas))))) 
(t  (i.  .ror  " ' %ADD-LEMMA  did  not  like  term:  'a"  term)))) 

Mefnn  add- lemma- 1st  (1st) 

(cond  (  (null  1st ) 
t) 

(t  (add-lemma  (car  1st) ) 

(add- lemma- 1st  (cdr  1st))))) 


(defun  apply-subst  (alist  term) 

(cond  ( (atom  term) 

(cond  ( (setq  temp-temp  (assq  term  alist) ) 

(cdr  temp-temp) ) 

(t  term)  )  ) 

(t  (cons  (car  term) 

(apply-subst-lst  alist  (cdr  term)))))) 


(defun  apply-subst-lst  (alist  1st) 

(cond  (  (null  1st ) 
nil) 

(t  (cons  (apply-subst  alist  (car  1st)) 

(apply-subst-lst  alist  (cdr  1st)))))) 

(defun  faisep  (x  1st) 

(or  (equal  x  (quote  (f))) 

(member  x  1st) ) ) 

(defun  one-way-unify  (terml  term2) 

(progn  (setq  unify-subst  nil) 

(one-way-unifyl  terml  term2))) 


(defun  one-way-unifyl  (terml  lerm2) 

(cond  ( (atom  term2) 

(cond  ( (setq  temp-temp  (assq  term2  unify-subst) ) 
(equal  terml  (cdr  temp-temp))) 

(t  (setq  unify-subst  (cons  (cons  term2  terml) 

unify-subst) ) 


t)  )  ) 

(  (atom  terml) 
nil) 

(  (eq  (car  terml) 

(car  term2) ) 

(one-way-unify 1-lst  (cdr  terml) 

(cdr  term2) ) ) 


(t  nil)  )  ) 


(defun  one-way-uni fyl-lst  (lstl  lst2) 
(cond  (  (null  lstl) 
t) 


((one-way-unifyl  (car  lstl) 

(car  lst2) ) 

(one-way-unifyl-lst  (cdr  lstl) 

(cdr  1st 2) ) ) 


(t  nil)  )  ) 
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(defun  rewrite  (term) 

(cond  ( (atom  term) 
term) 

(t  (rewrite-with-iemmas  (cons  (car  term) 

(rewrite-args  (cdr  term))) 
(get  (car  term) 

(quote  lemmas) ) ) ) ) ) 


(defun  rewrite-args  (1st) 

(cond  ( (null  1st) 
nil) 

(t  (cons  (rewrite  (car  1st)) 

(rewrite-args  (cdr  1st))))!) 


(defun  rewrite-with- lemmas  (term  1st) 

(cond  ( (null  1st ) 
term) 

( (one-way-unify  term  (cadr  (car  1st))) 

(rewrite  (apply-subst  unify-subst  (caddr  (car  1st))))) 
(t  (rewrite-with-lemmas  term  (cdr  1st))))) 


(defun  setup  0 
(add-lemma-lst 
(quote  ( (equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(  :c  -  L 

Cequa) 

(►  qu^ 

(equal 


(compile  form) 

(reverse  (codegen  (optimize  form) 
(nil)))) 

(eqp  x  y) 

(equal  (fix  x) 

(fix  y) ) ) 

(greaterp  x  y) 

(lessp  y  x) ) 

( lesseqp  x  y) 

(not  (lessp  y  x)  )  ) 

(greatereqp  x  y) 

(not  (lessp  x  y) ) ) 

(boolean  x) 

(or  (equal  x  (t)  ) 

(equal  x  (f ) ) ) ) 

(iff  x  y) 

(and  (implies  x  y) 

(implies  y  x) ) ) 

(evenl  x) 

(if  (zerop  x) 

(t) 

(odd  (1-  x! ) ) ) 

(countps-  1  pred) 

(countps-loop  1  pred  (zero) ) ) 
(fact-  i) 

(fact-loop  i  1) ) 

(reverse-  x) 

(reverse-loop  x  (nil))) 

(divides  x  y) 

(zerop  (remainder  y  x) ) ) 
(assume-true  var  alist) 

(cons  (cons  var  (t ) ) 
alist) ) 

(assume-false  var  alist! 

(cons  (cons  var  ( f )  ) 
alist)  ) 

(tautology-checker  x) 
autologyp  (normalize  x! 

(nil)  )  ) 

(falsify  x) 

(falsifyl  (normalize  x) 

(nil)  )  ) 

(prime  x) 

(and  (not  (zerop  x) ) 

(not  (equal  x  (addl  (zero)))) 
(primel  x  (1-  x) ) ) ) 
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(equal  (and  p  q) 

(if  d  (if  q  ( t ! 

(f  i  ) 

(f)  )  ) 

(equal  (or  p  q) 

(if  p  (t) 

(if  o  (t) 

(f)  ) 

(f)  )  ) 

(equal  (nor  p) 

(if  p  (f) 

(tm 

(equal  (implies  p  q) 

(if  p  (if  q  (t) 

(f)  ) 

(t))) 

(equal  (fix  x) 

(if  (numberp  x) 
x 

(zero)  )  ) 

(equal  (if  (if  a  be) 
d  e) 

(if  a  (if  b  d  e) 

(if  c  d  e) ) ) 

(equal  (zerop  x) 

(or  (equal  x  (zero) ) 

(not  (numberp  x)  )  )  ) 

(equal  (plus  (plus  x  y) 
z) 

(plus  x  (plus  y  z)  )  ) 

(equal  (equal  (plus  a  b) 

(zero) ) 

(and  (zerop  a) 

(2erop  b) )  ) 

(equal  (difference  x  x) 

(zero) ) 

(equal  (equal  (plus  a  b) 

(plus  a  c) ) 

(equal  (fix  b) 

(fix  c) ) ) 

(equal  (equal  (zero) 

(difference  x  v)  ) 

(not  (lessp  y  x) ) ) 

(equal  (equal  x  (difference  x  y)  ) 

(and  (numberp  x) 

(or  (equal  x  (zero) ) 

( zerop  y) ) ) ) 

(equal  (meaning  (plus-tree  (append  x  y) ) 
a) 

(plus  (meaning  (plus-tree  x) 
a) 

(meaning  (plus-tree  y) 

a)  )  ) 

(equal  (meaning  (plus-tree  (plus-fringe  x) ) 
a) 

(fix  (meaning  x  a) ) ) 

(equal  (append  (append  x  y) 
z) 

(append  x  (append  y  z )  ) ) 

(equal  (reverse  (append  a  b) ) 

(append  (reverse  b) 

( reverse  a)  )  ) 

(equal  (times  x  (plus  y  z)) 

(plus  (times  x  y) 

(times  x  z)  )  ) 

(equal  (times  (times  x  y) 
z) 

(times  x  (times  y  z)  )  ) 
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(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 


(equal  (times  x  y) 

(zero)  ) 

(or  (zerop  x) 

(zerop  y) ) ) 

(exec  (append  x  y) 
pds  envrn) 

(exec  y  (exec  x  pds  envrn) 
envrn) ) 

(mc-flatten  x  y) 

(append  (flatten  x) 

y) ) 

(member  x  (append  a  b) ) 

(or  (member  x  a) 

(member  x  b)  )  ) 

(member  x  (reverse  y)  ) 

(member  x  y)  ) 

(length  (reverse  x)  ) 

( length  x)  ) 

(member  a  (intersect  b  c)  ) 

(and  (member  a  b) 

(member  a  c) ) ) 

(nth  (zero) 
i) 

(zero)  ) 

(exp  i  (plus  j  k) ) 

(times  (exp  i  j) 

(exp  i  k)  )  ) 

(exp  i  (times  j  k)  ) 

(exp  (exp  i  j) 
k)  ) 

(reverse-loop  x  y) 

(append  (reverse  x) 

y) ) 

(reverse-loop  x  (nil)) 

(reverse  x)  ) 

(count-list  z  (sort-lp  x  y»i 
(plus  (count-list  z  x) 

(count-list  z  y) ) ) 

(equal  (append  a  b) 

(append  a  c) ) 

(equal  b  c)  ) 

(plus  (remainder  x  y) 

(times  y  (quotient  x  y)  )  ) 

(fix  x) ) 

(power-eval  (big-plusl  1  i  base) 
base) 

(plus  (power-eval  1  base) 
i)  ) 

(power-eval  (big-plus  x  y  i  base) 
base) 

(plus  i  (plus  (power-eval  x  base) 

(power-eval  y  base)))) 

(remainder  y  1) 

(zero)  ) 

(lessp  (remainder  x  y) 

y) 

(not  ( zerop  y) ) ) 

(remainder  x  x) 

(zero)  ) 

(lessp  (quotient  i  j) 
i) 

(and  (not  (zerop  i) ) 

(or  (zerop  j) 

(not  (equal  j  1) ) )  )  ) 

(lessp  (remainder  x  y) 
x) 

(and  (not  (zerop  y) ) 

(not  (zerop  x) ) 

(not  ( lessp  x  y) ) ) ) 
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(equal  (power-eval  (power-rep  i  base) 
base) 

(fix  i) ) 

(equal  (power-eval  (big-plus  (power-rep  i  base) 

(power-rep  j  base) 

(zero) 

base) 

base) 

(plus  i  j )  ) 

(equal  (gcd  x  y) 

(gcd  y  x) ) 

(equal  (nth  (append  a  b) 

i) 

(append  (nth  a  i) 

(nth  b  (difference  i  (length  a))))) 
(equal  (difference  (plus  x  y) 
x) 

(fix  y) ) 

(equal  (difference  (plus  y  x) 
x) 

(fix  y) ) 

(equal  (difference  (plus  x  y) 

(plus  x  z) ) 

(difference  y  z) ) 

(equal  (time3  x  (difference  c  w) ) 

(difference  (times  c  x) 

(times  w  x)  ) ) 

(equal  (remainder  (times  x  z) 
z) 

(zero) ) 

(equal  (difference  (plus  b  (plus  a  c) ) 
a) 

(plus  b  c)  ) 

(equal  (difference  (addl  (plus  y  z) ) 
z) 

(addl  y) ) 

(equal  (lessp  (plus  x  y) 

(plus  x  z)  ) 

(lessp  y  z)  ) 

(equal  (lessp  (times  x  z) 

(times  y  z)  ) 

(and  (not  (zerop  z) ) 

(lessp  x  y) ) ) 

(equal  (lessp  y  (plus  x  y) ) 

(not  (zerop  x) ) ) 

(equal  (gcd  (times  x  z! 

(times  y  z)  ) 

(times  z  (gcd  x  y)  )  ) 

(equal  (value  (normalize  x) 
a) 

(value  x  a) ) 

(equal  (equal  (flatten  x) 

(cons  y  (nil) ) ) 

(and  (nlistp  x) 

(equal  x  y) ) ) 

(equal  (listp  (gopher  x) ) 

(listp  x) ) 

(equal  (samefringe  x  y) 

(equal  (flatten  x) 

(flatten  y) ) ) 

(equal  (equal  (greatest-factor  x  y) 

(zero) ) 

(and  (or  (zerop  y) 

(equal  y  1)  ) 

(equal  x  (zero) ) ) ) 

(equal  (equal  (greatest-factor  x  y) 

1) 

(equal  x  1)  ) 
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(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 

(equal 


(numberp  (greatest-factor  x  y)  ) 

(not  (and  (or  (zerop  y) 

(equal  y  1) ) 

(not  (numberp  x) ) ) ) ) 

(times-list  (append  x  y) ) 

(times  (times-list  x) 

(times-list  y)  )  ) 

(prime-list  (append  x  y)  ! 

(and  (prime-list  x) 

(prime-list  y) ) ) 

(equal  z  (times  w  z )  ) 

(and  (numberp  z) 

(or  (equal  z  (zero)) 

(equal  w  1)  )  )  ) 

(greatereqpr  x  y) 

(not  (lessp  x  y) ) ) 

(equal  x  (times  x  y)  ) 

(or  (equal  x  (zero)  ) 

(and  (numberp  x) 

(equal  y  1)  )  )  ) 

(remainder  (times  y  x) 

y) 

(zero) ) 

(equal  (times  a  b) 

1) 

(and  (not  (equal  a  (zero))) 

(not  (equal  b  (zero))) 

(numberp  a) 

(numberp  b) 

(equal  (1-  a) 

(zero)) 

(equal  (1-  b) 

(zero)  )  )  ) 

(lessp  (length  (delete  x  1)) 

(length  1)  ) 

(member  x  1) ) 

(sort2  (delete  x  1)) 

(delete  x  (sort2  1) ) ) 

(dsort  x) 

(sort2  x) ) 

(length  (cons  xl 

(cons  x2 

(cons  x3  (cons  x4 

(cons  x5 

(cons  x6  x?) )))))) 

(plus  6  (length  x7) ) ) 

(difference  (addl  (addl  x) ) 

2) 

(fix  x) ) 

(quotient  (plus  x  (plus  x  y) ) 

2) 

(plus  x  (quotient  y  2))) 

(sigma  (zero) 
i) 

(quotient  (times  i  (addl  i) ) 

2)  ) 

(plus  x  (addl  y) ) 

(if  (numberp  y) 

(addl  (plus  x  y) ) 

(addl  x)  )  ) 

(equal  (difference  x  y) 

(difference  z  y)  ) 

(if  (lessp  x  y) 

(not  (lessp  y  z) ) 

(if  (lessp  z  y) 

(not  ( lessp  y  x) ) 

(equal  (fix  x) 

(fix  z) ) ) ) ) 
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(equal  (meaning  (plus-cree  (delete  x  y) ) 
a) 

(if  (member  x  y) 

(difference  (meaning  (plus-tree  y) 
a) 

(meaning  x  a) ) 

(meaning  (plus-tree  y) 
a)  )  ) 

(equal  (times  x  (addl  y)  ) 

(if  (numberp  y) 

(plus  x  (times  x  y) ) 

(fix  x)  )  ) 

(equal  (nth  (nil) 
i) 

(if  (zerop  i) 

(nil) 

(zero) ) ) 

(equal  (last  (append  a  b) ) 

(if  .(listp  b) 

(last  b) 

(if  (listp  a) 

(cons  (car  (last  a)) 
b) 

b)  )  ) 

(equal  (equal  (lessp  x  y) 

2) 

(if  (lessp  x  y) 

(equal  t  z) 

(equal  f  z)  )  ) 

(equal  (assignment  x  (append  a  b) ) 

(if  (assignedp  x  a) 

(assignment  x  a) 

(assignment  x  b)  )  ) 

(equal  (car  (gopher  x)  ) 

(if  (listp  x) 

(car  (flatten  x) ) 

(zero) ) ) 

(equal  (flatten  (cdr  (gopher  x) ) ) 

(if  (listp  x) 

(cdr  (flatten  x) ) 

(cons  (zero) 

(nil)  )  )  ) 

(equal  (quotient  (times  y  x) 

y) 

(if  (zerop  y) 

(zero) 

(fix  x)  )  ) 

(equal  (get  j  (set  i  val  mem)  ) 

(if  (eqp  j  i) 
val 

(get  j  mem)  )))))) 
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(defun  tautology?  (x  true-lst  false-lst! 

(cond  (  (truep  x  true-lst) 
t) 

((falsep  x  false-lst) 
nil) 

( (atom  x) 
nil) 

(  leq  (car  x) 

(quote  if)  ) 

(cond  (  (truep  (cadr  x) 
true-lst) 

(tautology?  (caddr  x) 

true-lst  false-lst)) 

( (falsep  (cadr  x) 

false-lst) 

(tautology?  (cadddr  x) 

true-lst  false-lst)) 

(t  (and  (tautologyp  (caddr  x) 

(cons  (cadr  x) 
true-lst) 


(t  nil))) 


(tautologyp 


false-lst) 

(cadddr  x) 
true-lst 
(cons  (cadr  x) 

false-lst) ) ) ) ) ) 


(defun  tautp  (x) 

(tautologyp  (rewrite  x) 
nil  nil)) 


(defun  test  () 

(prog  (ans  term) 

(setq  term 

(apply-subst 

(quote  ( (x  f  (plus  (plus  a  b) 

(plus  c  (zero) ) ) ) 

(y  f  (times  (times  a  b) 

(plus  c  d)  )  ) 

(z  f  (reverse  (append  (append  a  b) 

(nil)  )  )  ) 

(u  equal  (plus  a  b) 

(difference  x  y) ! 

(w  lessp  (remainder  a  b) 

(member  a  (length  b) ) ) ) ) 

(quote  (implies  (and  (implies  x  y) 

(and  (implies  y  z) 

(and  (implies  z  u) 

(implies  u  w) ) ) ) 
(implies  x  w) ) ) ) ) 

(setq  ans  (tautp  term)))) 


(defun  trans-of-implies  (n) 

(list  (quote  implies) 

(trans-of-impliesl  n) 

(list  (quote  implies) 

On))) 

(defun  trans-of-impliesl  (n) 

(cond  ( (equal  n  1) 

(list  (quote  implies) 

0  1>) 

(t  (list  (quote  and) 

(list  (quote  implies) 
(1-  n) 
n) 

(trans-of-impliesl  (1- 


;  I  think  (eql  n  1)  may  work  here 


n)  ) ) )  )  ) 
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(defun  truep  (x  1st) 

(or  (equal  x  (quote  ( t ) ) ) 
(member  x  1st) ) ) 

(eval-when  (load  eval) 

(setup) ) 
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; ; ;  BROWSE 

;;;  Benchmark  to  create  and  browse  through  an  Al-like  data  base  of 
; ; ;  units . 

;;;  call:  (browse) 

;;;  n  is  #  of  symbols 

;;;  m  is  maximum  amount  of  stuff  on  the  plist 

;;;  npats  is  the  number  of  basic  patterns  on  the  unit 

;;;  ipats  is  the  instantiated  copies  of  the  patterns 

(defvar  rand  21.) 

(defun  seed  0  (setq  rand  21.)) 

(defmacro  charl  (x)  ' (aref  (string  ,  x)  0))  ;  maybe  SYMBOL-NAME 

(defun  init  (n  m  npats  ipats) 

(let  ((ipats  (copy-tree  ipats))) 

(do  ( (p  ipats  (cdr  p) ) ) 

((null  (cdr  p) )  (rplacd  p  ipats))) 

(do  (  (n  n  (1-  n) ) 

(i  m  (cond  ( (=  i  0)  m) 

<t  (1-  i)))) 

(name  (gensym)  (gensym) ) 

(a  ())) 

<<=  n  0)  a) 

(push  name  a) 

(do  (  (i  i  (1-  i) )  ) 

((=  i  0)) 

( set f  (get  name  (gensym) )  nil) ) 

(setf  (get  name  'pattern) 

(do  (  (i  npats  (1-  i)  ) 

(ipats  ipats  (cdr  ipats) ) 

(a  on 

((=■10)  a) 

(push  (car  ipats)  a) ) ) 

(do  (  ( j  (-  m  i)  (1-  j)  )  ) 

((=  j  0)) 

(setf  (get  name  (gensym))  nil))))) 


(defun  browse-random  () 

(setq  rand  (mod  (*  rand  17.)  251.))) 

(defun  randomize  (1) 

(do  (  (a  '  ()  )  ) 

( (null  1)  a) 

(let  ( (n  (mod  (browse-random)  (length  1)))) 
(cond  ( (=  n  0) 

(push  (car  1)  a) 

(setq  1  (cdr  1) ) ) 

(t 

(do  (  (n  n  (1-  n) ) 

(x  1  (cdr  x) ) ) 

(<=  n  1) 

(push  (cadr  x)  a) 

(rplacd  x  (cddr  x) ))))))! ) 


gabriel • 37 


[lisp]  browse. 1 


(defun  match  (pat  dat  alist) 

(cond  ((null  pat ) 

(null  dat ) ) 

( (null  dat)  ( )  ) 

(  (or  (eq  (car  pat)  '  ?) 

(eq  (car  pat) 

(car  dat) ) ) 

(match  (cdr  pat)  (cdr  dat)  alist)) 

( (eq  (car  pat)  ' *) 

(or  (match  (cdr  pat)  dat  alist) 

(match  (cdr  pat)  (cdr  dat)  alist) 

(match  pat  (cdr  dat)  alist))) 

(t  (cond  ((atom  (car  pat)) 

(cond  ( (eq  (charl  (car  pat))  #\?) 

(let  ( (val  (assoc  (car  pat)  alist))) 
(cond  (val  (match  (cons  (cdr  val) 

(cdr  pat) ) 
dat  alist) ) 

(t  (match  (cdr  pat) 

(cdr  dat) 

(cons  (cons  (car  pat) 
(car  dat) ) 
alist)))))) 

( (eq  (charl  (car  pat))  #\») 

(let  ((val  (assoc  (car  pat)  alist))) 
(cond  (val  (match  (append  (cdr  val) 

(cdr  pat) ) 
dat  alist) ) 


(t 


(t 

(do  ((1  ()  (nconc  1  (cons  (car  d)  nil))) 
(e  (cons  ()  dat)  (cdr  e)  ) 

(d  dat  (cdr  d) ) ) 

((null  e)  ()) 

(cond  ((match  (cdr  pat)  d 

(cons  (cons  (car  pat)  1) 
alist) ) 

(return  t) ))))))))  ) 


(and 

(not  (atom  (car  dat))) 

(match  (car  pat) 

(car  dat)  alist) 

(match  (cdr  pat) 

(cdr  dat)  alist))))))) 


(defun  browse  () 

(seed) 

(investigate  (randomize 

(init  100.  10.  4.  ' ( (a  a  a  b  b  b  b  a  a  a  a  a  b  b  a  a  a) 
(aabbbbaa 
(a  a)  (b  b)  ) 

(a  a  a  b  (b  a)  baba)))) 

'  ( ( *  a  ?b  *b  ?b  a  *a  a  *b  *a) 

(*a  *b  *b  *a  (*a)  ( *b) ) 

(?  ?  *  (b  a)  *??)))) 


(defun  investigate  (units  pats) 

(do  ((units  units  (cdr  units))) 

(  (null  units) ) 

(do  ((pats  pats  (cdr  pats))) 

(  (null  pats) ) 

(do  (  (p  (get  (car  units)  'pattern) 
(cdr  p) ) ) 

( (null  p)  ) 

(match  (car  pats)  (car  p)  ()))))) 
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; ; ;  CTAK 

;;;  A  version  of  the  TAKeuchi  function  that  uses  the  CATCH/THROW 
;;;  facility. 

;;;  call:  (ctak  18.  12.  6.) 

(defun  ctak  (x  y  z) 

(catch  'ctak  (ctak-aux  x  y  z) ) ) 

(defun  ctak-aux  (x  y  z) 

(cond  ((not  (<  y  x) )  ;xy 
(throw  ' ctak  z )  ) 

(t  (ctak-aux 

(catch  'ctak 

(ctak-aux  (1-  x) 

y 

z)  ) 

(catch  'ctak 

(ctak-aux  (1-  y) 
z 

X)  ) 

(catch  'ctak 

(ctak-aux  (1-  z) 
x 

y) ))  )  ) ) 
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; ; ;  FRPOLY 

;;;  Benchmark  from  Berkeley  based  on  polynomia.  aritr.metic. 

;;;  Originally  writen  in  Franz  Lisp  by  Richard  Fateman.  PDIFFER1 
;;;  appears  in  the  code,  but  it  is  not  defined;  it  is  not  used  in 
;;;  this  test,  however. 

;;;  There  are  four  sets  of  three  tests  -  call: 

;;;  (pexptsq  r  2)  (pexptsq  r2  2)  (pexptsq  r3  2) 

;;;  (pexptsq  r  5)  (pexptsq  r2  5)  (pexptsq  r3  5) 

;;;  (pexptsq  r  10)  (pexptsq  r2  10)  (pexptsq  r3  10) 

;;;  (pexptsq  r  15)  (pexptsq  r2  15)  (pexptsq  r3  15) 

(defvar  ans) 

(defvar  coef) 

(defvar  f) 

(defvar  inc) 

(defvar  i) 

(defvar  qq) 

(defvar  ss) 

(defvar  v) 

(defvar  *x») 

(defvar  *alpha*) 

(defvar  *a*) 

(defvar  *b*) 

(defvar  *chk) 

(defvar  *1) 

(defvar  *p) 

(defvar  q*) 

(defvar  u*) 

(defvar  *var| 

(defvar  *y*) 

(defvar  r) 

(defvar  r2) 

(defvar  r3) 

(defvar  start) 

(defvar  rest) 

(defvar  res2) 

(defvar  res3) 

(defmacro  pointergp  (x  y)  '  (>  (get  ,x  'order)  (get  ,y  'order))) 

(defmacro  pcoefp  (e)  '(atom  ,e)) 

(defmacro  pzerop  (x) 

'(if  (numberp  ,  x)  ;  no  signp  in  CL 

(zerop  , x) ) ) 

(defmacro  pzero  0  0) 

(defmacro  cplus  (x  y)  ’(+  ,x  ,y)) 

(defmacro  ctimes  (x  y)  '(*  ,x  ,  y)  ) 

(defun  pcoefadd  (e  c  x) 

(if  (pzerop  c) 
x 

(cons  e  (cons  c  x) ) ) ) 

(defur.  pcplus  (c  p) 

(if  (pcoefp  pi 
(cplus  p  c) 

(psimp  (car  p)  (pcplusl  c  (cdr  p) ) ) ) ) 

(defun  pcplusl  (c  x) 

(cond  ( (null  x) 

(if  (pzerop  c) 
nil 

(cons  0  (cons  c  nil) ) ) ) 

(  (pzerop  (car  x)  ) 

(pcoefadd  0  (pplus  c  (cadr  x) )  nil)) 

(t 

(cons  (car  x)  (cons  (cadr  x)  (pcplusl  c  (cddr  x)  )  )  )  )  )  ) 
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(defun  pctimes  (c  pi 
(if  (pcoefp  p) 

(ctimes  c  p) 

(psimp  (car  p)  (pctimesl  c  (cdr  p) ) ) ) ) 

(defun  pctimesl  (c  x) 

(if  (null  x) 
nil 

(pcoefadd  (car  x) 

(ptimes  c  (cadr  x)  I 
(pctimesl  c  (cddr  x)  I  )  )  ! 

(defun  pplus  (x  y) 

(cond  ( (pcoefp  x) 

(pcplus  x  y) ) 

( (pcoefp  y) 

(pcplus  y  x) I 
(  (eq  (car  x)  (car  y)  ) 

(psimp  (car  x)  (pplusl  (cdr  y)  (car  x) ) ) ) 

( (pointergp  (car  x)  (car  y ) ) 

(psimp  (car  x)  (pcpiusl  y  (cdr  xl  I  I  ) 

(t 

(psimp  (car  y)  (pcpiusl  x  (cdr  y) ) ) ) I) 

(defun  pplusl  (x  y) 

(cond  (  (null  x)  /) 

(  (null  y)  x) 

(  (=  (car  x)  (car  y)  I 
(pcoefadd  (car  x) 

(pplus  (cadr  x)  (cadr  y) ) 

(pplusl  (cddr  x)  (cddr  y) ) ) I 
(  (>  (car  x)  (car  y)  ) 

(cons  (car  x)  (cons  (cadr  x)  (pplusl  (cddr  x)  y) ) ) ) 

(t  (cons  (car  y)  (cons  (cadr  y)  (pplusl  x  (cddr  y)  )))))) 

(defun  psimp  (var  x) 

(cond  ( (null  x)  0) 

(  (atom  x)  x) 

( (zerop  (car  x) ) 

(cadr  x)  ) 

(t 

(cons  var  x)  )  )  ) 

(defun  ptimes  (x  y) 

(cond  ( (or  (pzerop  x)  (pzerop  y) ) 

(pzero)  ) 

(  (pcoefp  x) 

(pctimes  x  y) ) 

( (pcoefp  y) 

(pet imes  y  x) ) 

(  (eq  (car  x)  (car  y)  ) 

(psimp  (car  x)  (ptimesl  (cdr  x)  (cdr  y)  I  )  ) 

( (pointergp  (car  x)  (car  y) ) 

(psimp  (car  x)  (pctimesl  y  (cdr  x) ) ) ) 

(t 

(psimp  (car  y)  (pctimesl  x  (cdr  y) ) ) ) I ) 

(defun  ptimesl  (*x*  y) 

(prog  (u*  v) 

(setq  v  ( setq  u*  (ptlmes2  y) ) ) 
a 

(setq  *x*  (cddr  *x'l  ) 

(if  (null  *x*> 

(return  u*) ) 

(ptimes3  y) 

(go  a) )  ) 
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(defun  ptimes2  (y) 

(if  (null  y) 
nil 

(pcoefadd  (+  (car  *x*)  (car  y)  ) 

(ptimes  (cadr  *x')  (cadr  y)  ) 

(ptimes2  (cddr  y) ) ) ) ) 

(defun  ptimes3  (y) 

(prog  (e  u  c) 

al  (if  (null  y) 

(return  nil) ) 

(setq  e  (+  (car  *x*|  (car  y)  ) 

c  (ptimes  (cadr  y)  (cadr  *x*)  )) 

(cond  ( (pzerop  c) 

( setq  y  (cddr  y ) ) 

(go  al)  ) 

(  (or  (null  v)  (>  e  (car  v)  )  ) 

(setq  u*  (setq  v  (pplusl  u*  (list  e  c) ) ) ) 

(setq  y  (cddr  y) ) 

(go  al)  ) 

( (=  e  (car  v)  ) 

(setq  c  (pplus  c  (cadr  v)  )  ) 

(if  (pzerop  c)  ;  never  true,  evidently 

(setq  u*  (setq  v  (pdifferl  u*  (list  (car  v)  (cadr  v) ) ) ) ) 
(rplaca  (cdr  v)  c) ) 

(setq  y  (cddr  y) ) 

(go  al)  )  ) 

a  (cond  ( (and  (cddr  v)  (>  (caddr  v)  e) ) 

(setq  v  (cddr  v) ) 

(go  a) ) ) 

(setq  u  (cdr  v) ) 

b  (if  (or  (null  (cdr  u) )  (<  (cadr  u)  e) ) 

(rplacd  u  (cons  e  (cons  c  (cdr  u) ) ) )  (go  e ) ) 

(cond  ((pzerop  (setq  c  (pplus  (caddr  u)  c) ) ) 

(rplacd  u  (cdddr  u)  ) 

(go  d)  ) 

(t 

(rplaca  (cddr  u)  c) ) ) 
e  (setq  u  (cddr  u) ) 
d  (setq  y  (cddr  y) ) 

(if  (null  y) 

(return  nil) ) 

(setq  e  (+  (car  *x*)  (car  y) ) 

c  (ptimes  (cadr  y)  (cadr  *x*) ) ) 
c  (cond  ( (and  (cdr  u)  (>  (cadr  u)  e) ) 

(setq  u  (cddr  u) ) 

(go  c) ) ) 

(go  b) )  ) 

(defun  pexptsq  (p  n) 

(do  ( (n  (floor  n  2)  (floor  n  2)) 

(s  (if  ( oddp  n)  p  1) ) ) 

( (zerop  n)  s) 

(setq  p  (ptimes  p  p > ) 

(and  (oddp  n)  (setq  s  (ptimes  s  p) ) ) ) ) 

(eval-when  (load  eval) 

(setf  (get  'x  'order)  1) 

(setf  (get  'y  'order)  2) 

(setf  (get  'z  'order)  3) 

(setq  r  (pplus  '  (x  1  1  0  1)  (pplus  '  (y  1  1)  '  (z  1  1)  )  ) 
r2  (ptimes  r  100000) 
r3  (pt imes  r  1.0)) 


r=  x+y+z+1 
r2  =  100000*r 
r3  =  r  with 
floating  point 
coefficients 
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;;;  PUZZLE 

;;;  Forest  Baskett' s  Puzzle  benchmark,  originally  written  in  Pascal. 

;;;  call:  (start) 

(eval-when  (load  eval) 

(defconstant  size  511.) 

(defconstant  classmax  3.) 

(defconstant  typemax  12.)) 

(defvar  iii  0) 

(defvar  kount  0) 

(defvar  d  8.) 

(aefvar  piece-count  (make-array  ( 1  classmax)  :initial-element  0)) 
(defvar  class  (make-array  (1+  typemax)  :initial-element  0)) 

(defvar  piecemax  (make-array  (1+  typemax)  : initial-element  0) ) 
(defvar  puzzle  (make-array  (1+  size))) 

(defvar  p  (make-array  (list  (1+  typemax)  (1+  size)))) 

(defun  fit  (i  j) 

(let  ((end  (aref  piecemax  i) ) ) 

(do  ( (k  0  (1+  k) ) ) 

( (>  k  end)  t) 

(cond  ( (aref  p  i  k) 

(cond  ((aref  puzzle  <+  j  k) ) 

(return  nil) ))))))) 


(defun  place  (1  j) 

(let  ((end  (aref  piecemax  i) ) ) 

(do  (  (k  0  (1+  k)  )  ) 

((>  k  end)) 

(cond  (  (aref  p  i  k) 

(setf  (aref  puzzle  (+  j  k) )  t) ) ) ) 

(setf  (aref  piece-count  (aref  class  i) )  (-  (aref  piece-count  (aref  class  i) )  1)) 

(do  (<k  j  (1+  k) ) ) 

( (>  k  size) 

0  1  (terpri) 

(princ  "Puzzle  filled") I# 

0) 

(cond  ( (not  (aref  puzzle  k)  ) 

(return  k) ) ) ) ) ) 

(defun  puzzle-remove  (i  j) 

(let  ((end  (aref  piecemax  i) ) ) 

(do  ( (k  0  (1+  k) )  ) 

( (>  k  end) ) 

(cond  (  (aref  p  i  k) 

(setf  (aref  puzzle  (+  j  k) )  nil)))) 

(setf  (aref  piece-count  (aref  class  i))(+  (aref  piece-count  (aref  class  i) )  1)))) 

#1 (defun  puzzle-remove  (i  j) 

(let  ((end  (aref  piecemax  i ) ) ) 

(do  ( (k  0  (1+  k) ) ) 

( (>  k  end) ) 

(cond  ((aref  p  i  k)  (setf  (aref  puzzle  (+  j  k) )  nil))) 

(setf  (aref  piece-count  (aref  class  i) )  (+  (aref  piece-count  (aref  class  i) )  I)))))  I# 
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(defun  trial  <j) 

(let  (  (k  0)  ) 

(do  ((i  0  (1+  i»)l 

( (>  i  typemax)  (setq  kount  (1+  kount) )  nil) 

(cond  ((not  (=  (aref  piece-count  (aref  class  i))  0)) 

(cond  ( (fit  i  j) 

(setq  k  (place  i  j) ) 

(cond  (  (or  (trial  k) 

(=  k  0)) 

(format  t  "‘%Piece  '4D  at  -4D."  (+  i  1) 
(setq  kount  (+  kount  1)) 

(return  t) ) 

(t  (puzzle-remove  i  j)))))))))) 

(defun  define-piece  (iclass  ii  jj  kk) 

( let  ( ( index  0) ) 

(do  ((i  0  (1+  i))) 

(  (>  i  ii)  ) 

(do  (  ( j  0  (1+  j)  )  ) 

((>  j  jj)) 

(do  ( (k  0  (1+  k) ) ) 

( (>  k  kk)  ) 

(setq  index  (+  i  (*  d  (+  j  (*  d  k))))) 

(setf  (aref  p  iii  index)  t ) ) ) ) 

(setf  (aref  class  iii)  iclass) 

(setf  (aref  piecemax  iii)  index) 

(cond  ((not  (=  iii  typemax)) 

(setq  iii  (+  iii  1) ) ) ) ) ) 


(defun  start  () 

(do  (  (m  0  (1+  m)  )  ) 

( (>  m  size) ) 

(setf  (aref  puzzle  m)  t ) ) 

(do  <(i  1  (1+  i) ) ) 

((>  i  5)) 

(do  (  (-j  1  (1+  j)  )  ) 

<(>  j  5)) 

(do  ( (k  1  (1+  k)  )  ) 

((>  k  5)) 

(setf  (aref  puzzle  (+  i  (*  d  (+  j  (*  d  k) ) ) ) )  nil)))) 
(do  ( (i  0  (1+  i) )  ) 

(  (>  i  typemax)) 

(do  ( (m  0  ( 1+  m)  ) ) 

( (>  m  size) ) 

(setf  (aref  pirn)  nil))) 

(setq  iii  0) 

(define-piece  0310) 

(define-piece  0103) 

(define-piece  0031) 

(define-piece  0130) 

(define-piece  0301) 

(define-piece  0013) 

(define-piece  1200) 

(define-piece  1020) 

(define-piece  1002) 

(define-piece  2110) 

(define-piece  2101) 

(define-piece  2011) 

(define-piece  3111) 


(+  k  1)  ) 
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(setf  (aref  piece-count  0)  13.) 

(setf  (aref  piece-count  1)  3) 

(setf  (aref  piece-count  2)  1) 

(setf  (aref  piece-count  3)  1) 

(let  Km  (+  1  (*  d  (+  1  d))]) 

(n  0) (kount  0) ) 

(cond  ((fit  0  m)  (setq  n  (place  0  n») ) ) 

(t  (format  t  " '%Error . " ) ) 1 
(cond  ( (trial  n) 

(format  t  "'%Success  in  ~4D  trials, 
(t  (format  t  %Failure .")))) ) 


kount) > 
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;;;  The  TAKeuchi  function  with  special  variables  instead  of  parameter 
;;;  passing. 

;;;  call:  ( stale  18.  12.  6.)  ) 

(defvar  x) 

(defvar  y) 

(defvar  z) 

(defun  stak  (x  y  z) 

(stak-aux) ) 


(defun  stak-aux  () 

(if  (not  (<  y  x)  ) 
z 

(let  ( (x  (let  ( (x  (1-  x)  ) 

(y  y) 

(z  z)  ) 

( stak-aux) ) ) 

(y  (let  ( (x  (1-  y!  ) 
(y  z) 

(z  x)  ) 

(stak-aux) ) ) 

(z  (let  ((x  (1-  z)) 
(y  x) 

(z  y)) 

(stak-aux) ) ) ) 
(stak-aux) ) ) ) 
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; ; ;  tak 

;;;  A  vanilla  version  of  the  TAKeuchi  function  and  one  with  tail 
;;;  recursion  removed. 

;;;  call:  (tak  18.  12.  6.) 

(defun  tak  (x  y  z) 

(if  (not  (<  y  x) )  ;  xy 

z 

(tak  (tak  (1-  x)  y  z) 

(tak  (1-  y)  z  x) 

(tak  (1-  z)  x  y) ) ) ) 

;;;  call:  '*  rt=/  18.  12.  6.) 

(defun  trtak  (x  y  z) 

(prog  () 
tak 

(if  (not  (<  y  x) ) 

(return  z) 

(let  (  (a  (tak  (1-  x)  y  z)  ) 

(b  (tak  (1-  y)  z  x)  )  ) 

(setq  z  (tak  (1-  z)  x  y) 
x  a 
y  b) 

(go  tak) ) ) ) ) 
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;;;  TAKL 

;;;  The  TAKeuchi  function  using  lists  as  counters. 

;;;  call:  (mas  181  121  61) 

(defun  listn  (n) 

(if  (not  (=  0  n) ) 

(cons  n  (listn  (1-  n) ) ) ) ) 

(defvar  181  (listn  18.)) 

(defvar  121  (listn  12.)) 

(defvar  61  (listn  6.)) 

(defun  mas  (x  y  z) 

(if  (not  (shorterp  y  x) ) 
z 

(mas  (mas  (cdr  x) 
y  z) 

(mas  (cdr  y) 
z  x) 

(mas  (cdr  z) 
x  y) )  )  ) 

(defun  shorterp  (x  y) 

(and  y  (or  (nu»l  x) 

(shorterp  (cdr  x) 

(cdr  y)  )  )  )  ) 
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#  /* 

ili.m:  benchmark  ili  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s) :  S _ OPTIONS _ S 

% 

%  ili 

% 

%  Seif  Haridi  (Swedish  Institute  of  Computer  Science) 

% 

%  (modified  August  1986  by  Evan  Tick) 

% 

%  intuitionistic  logic  interpreter 
# if  BENCH 

#  include  ili -bench" 

#else 

ffcption  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/l." 

#  if  SHOW 

ili  q(I,  R,  P>, 

(s (P)  ->  R  =  provable  ;  R  *  unprovable) , 
write('Query  '),  write(I),  write!':  '),  write(P),  nl, 
write (success) ,  nl,  nl, 
fail . 

ili. 

#  else 

ili  :-  q<^,  _,  P), 

3(p)  , 
fail. 

ili. 

#  endif 
#endif 

#option  " 

>  ili  code  includes  several  (non-standard)  operators. 

>  If  one  of 

> 

>  C_PL  QUINTUS_PL  SICSTUS_PL 

> 

>  is  selected,  then  op/3  directives  are  generated  for 

>  these  automatically.  If  your  Prolog  system  handles 

>  op/3,  then  you  may  add  an  option  for  it  to  the  list 

>  above . " 

#if  C_PL  |  |  QUINTUS__PL  I  I  SICSTUS_PL 

#  include  "operator"  /*  op/3  directives  */ 

#else 

#  message  "WARNING:  load  op/3  directives  from  (file)  operator" 
#e ndif 


ili  el 


ili.m 

%  query  set 


q(l,  provable,  a  4  b  <->  b  4  a  )• 

q(2,  provable,  a  #  b  <->  b  *  a  )  • 

q(3,  provable,  (a  4  b)  4  c  <->  (a  4  b)  4  c  )  . 

q(4,  provable,  (a  #  b)  #c  <->  a#  (b  #  c)  )• 

q(5,  provable,  a  #  (b  4  c)  <->  (a  #  b)  4  (a  #  c)  )  . 

q(6,  provable,  a  4  (b  #  c)  <->  (a  4  b)  #  (a  4  c)  ). 

q(7,  provable,  a  =>  ((a  =>  ff)  =>  ff)  )- 

q  ( 8,  provable,  (a  =>  (b  =>  c)  )  =>  (a  4  b  =>  c)  ). 

q(9,  provable,  a  «>  (b  =>  a)  )  • 

q  ( 10 ,  provable,  a  =>  ((a  =>  ff)  =>  b)  )• 

q(ll,  provable,  (  (a  #  b)  =>  ff)  =>  (a  =>  ff)  4  (b  =>  ff)  ). 

q(12,  provable,  {(a  =>  ff)  #  !b  =>  ff)  )  =  >  (a  4  b  =>  ff)  ). 

q(13,  provable,  ((a  =>  ff)  #  b)  =>  (a  =>  b)  ). 

q ( 1 4 ,  provable,  (a  =>  b)  =>  ( (b  =>  ff)  =>  (a  =>  ff ) )  ). 

q ( 15 ,  provable,  (a  =>  b)  =>  ( (b  =>  c)  =>  (a  =>  c)  )  ). 

q(16,  provable,  ff  <->  a  4  (a  =>  ff)  )• 

q  (17,  provable,  e  (X,  p(X)  #  r!X))  =>  e(Y,  p(Y))  #  e(Z,  r  (2)  )  ). 

q  ( 18 ,  provable,  a(X,  p(X)  4  r  (X)  )  =>  a(Y,  p  ( Y)  )  4  a(Z,r(Z))  ). 

q  (19,  provable,  (e  (X,  p(X))  =>  ff)  =>  a  (Y,  p(Y)  =>  ff)  ). 

q  (20,  provable,  e  (X,  p(X)  =>  ff)  =>  (a(Y,  p  ( Y)  )  =>  ff)  ). 

q(21,  provable,  a(X,  b  =>  p  (X)  )  =>  (b  =>  a(Y,  p  ( Y)  )  )  ). 

q(22,  provable,  e(X,  a  =>  p  (X)  )  =>  (a  =>  e(Y,  p(Y)))  ). 

q  (23,  provable,  b  #  a  (X.  p(X))  ->  a  (Y,  b  #  p  (Y)  )  ). 

q  (24,  provable,  b  4  e  (X,  p(X))  =>  e(Y,  b  4  p(Y))  ). 

q  (25 ,  provable,  e(X,  p(X)  =>  b)  =>  (a(Y,  p(Y))  =>  b)  ). 

q  (26,  provable,  a  (X,  p(X)  =>  b)  =>  (e  (Y,  p(Y))  =>  b)  ). 

q (27 ,  provable,  a (X,  e (Y,  Y  =  X) )  ). 

q(28,  unprovable,  e(X,  a  ( Y,  Y  =  X)  )  ). 

q (29,  unprovable,  e(X,  a(Y,  f(Y)  =  X)  )  ). 

q(30,  provable,  a  (X,  professor  (X)  =>  e(Y,  teaches  (X,  Y)  )  )  ), 

q ( 3 1 ,  provable,  e (X,  e (Y,  (X  =  Y  =>  f f )  ) )  ). 

q  (32,  provable,  e  (X,  e(Y,  (X  -  Y  =>  f  f)  4  X  »  1  4  Y  =  2)  >  >. 

q (33,  provable,  e (X,  a (Y,  X  *  Y  ->  X  *  Y) )  ). 

q (34 ,  unprovable,  e (X,  a(Y,  X  -  Y  =>  ff)  )  ). 

q(35,  unprovable,  a  (X,  e(Y,  X  =  Y  =>  ff)  )  ). 

q  (36,  provable,  a  (X,  e  (Y,  (X  =  Y  »>  Y  =  1)  4  Y=l)  )  )  . 

q  (37,  unprovable,  e(X,  e(Y,  (X  =  Y  =>  ff)  4  X  *  1  4  Y  -  1)  )  ). 

q(38,  provable,  a(X,  brother  (X,  _)  =>  male(X))  ). 

/*  added  by  ET  08-10-86  */ 

q ( 10 1 ,  provable,  e (X,  lessall (X,  [b,  c,  d] ) )  ). 

/*  added  by  ET  08-10-86  */ 

q(102,  unprovable,  e(X,  lessall  (X,  [a,  b,  c,  d) ) )  ). 


%  intuitlonistic  logic  interpreter 
((option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (s/1). 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
#if  DUMMY 

s  (_)  . 

♦halt 

Oendif 

s (P)  :-  sb ( (] , P,  ( J )  . 
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sb(_L,tt,_CE)  !. 

sb (L, F1SF2 , CE)  !, 

sb(L,Fl,CE)  , 
sb(L,F2,CE)  . 
sb (L, F 1#F2 , CE)  !, 

sf  (L,F1#F2,CE)  . 
sb(L,a(V,F)  ,CE)  !, 

replace  (X/V,  a  (V,  F) ,  a  (X,  Fl )  ), 
star  (X)  , 

freeVars  (a  (X,  FI)  (VL)  , 
sb  (L,  FI,  CE)  , 
checkBinding (VL, X) . 
sb  (L,  e  (V,  F )  ,  CE)  !, 

sf  (L,e(V,F),CE)  . 
sb (L, F1<->F2, CE)  !, 

sb(L,Fl=>F2,CE) , 
sb (L, F2=>F1, CE) . 
sb(L,Fl=>F2,CE)  !, 

sb ( [Fl I L] , F2, CE)  . 
sb (L, T1=T2,CE)  !, 

sf  (L,T1=T2,CE)  . 

sb(_L,P,_CE)  my_builtin  (P)  ,  !,  /*  INCOMPLETE  */ 

call  (P)  . 
sb(L, A, CE) 

sf  (L,A,CE)  . 

sf((],e(V,F),CE>  !, 

replace (X/V, e (V, F) , e (X,F1) ) , 
sb ( [ ] , Fl, CE) . 
sf([],Fl#F2,CE)  !, 

( sb  (  [  ] , Fl, CE)  ;  sb ( [ ] , F2, CE) ) . 
sf  ( (],T1«T2,CE)  !, 

unifyb (Tl,  T2,  CE)  . 
sf(n,A,CE)  ! , 

(findStatement (A,H<-B) , 
unifyb (A, H, CE) , 
sb ( [ ] , B, CE)  ; 
f indAtom (A, H, CE) , 
unifyb  (A,  H,  CE)  )  . 
sf([ffl  FR],_CF,_CE)  !. 

sf ( (F1DF2 IFR] ,CF,CE)  !, 

sf ( [Fl IFR] ,CF,CE) , 
sf ((F2|FR],CF,CE) . 
sf( [F1SF2IFR],CF,CE) 

sf <[F1,F2|FR],CF,CE) . 
sf ( [a (V, F) I FR] , CF , CE)  !, 

replace (X/V, a (V,F) , a (X,F1) ) , 
sf <[F1|FR],CF,CE)  . 
sf ( [e (V, F) |FR],CF,CE>  !, 

replace  (X/V,e(V,F),e(X,Fl)), 
star  IX) , 

freeVars (e (X, Fl) , VL) , 
sf (lF1|FR),CF,CE), 
checkBinding (VL, X) . 

sf ( [Fl<->F2 ! FR J , CF, CE)  !, 

sf <(F1->F2,F2=>F1IFR],CF,CE) . 
sf ( [F1=>F2 IFR] ,CF,CE)  !, 

( sb (FR, Fl, CE) , 
sf t[F2!FR],CF,CE)  ; 
sf (FR,CF,CE) )  . 
sf ( [T1-T2 IFR) ,CF,CE)  !, 

X=sf ( [T1-T2 IFR] , CF , CE) , 
unifyf  (T1,T2,CE,CE1,X)  , 

(CEl=fall  ;  sf  (FR,CF,CE1)  )  . 
sf ( (Atom|FR],CF,CE) 

findStatement (Atom, H<->B) , 
unifyb (Atom, H, CE) , 
append  (FR,  [B]  ,  FR1)  , 
sf  <FR1,CF,CE)  . 


ili  *3 


ili  .m 


sf ( (AtomlFR],CF,CE) 

sf (FR, CF,  [Atom  ICE] )  . 

star (*(_)). 

f  indAtom  (A,  A,  E)  atom(A),  member(A,E),  !. 

f indAtom (A, H, E) 

functor (A, F, N) , 
functor  (H, F, N) , 
membe  r ( H , E ) . 

f  reeVars  (X,  [  ]  )  isstar(X),  !. 

f reeVars (X, [X] )  var(X),  !. 

f reeVars (X, L)  isdelay(X),  !, 

dereference  (X,  X2,  [  ] )  , 

(isdelay (X2)  ->  L=(X2]  ;  L=  [  ] )  . 
f reeVars (A, (] )  atomic (A),  !. 

f  reeVars  (a  (X,  F)  ,  V)  !, 

f reeVars (F, VI) , 
del  (X,  VI,  V)  . 
f  reeVars  (e  (X,  F)  ,  V)  !, 

f reeVars (F,  VI) , 
del (X, VI, V)  . 

f reeVars (T, V)  compound  (T), 

T  [JTs], 

freeVarsList (Ts, V) . 

f reeVarsList ( [ ] , [] ) . 
freeVarsList ( (T I Ts] ,V)  !, 

freeVars (T,  VI) , 
freeVarsList  (Ts,  V2) , 
append  (VI,  V2,V)  . 

/*  checkBinding (L,  V)  \+  in  (L,  V) ,  !.  */ 

checkBinding ( [] ,_)  !. 

checkBinding ( [XI L] , V)  (var(X)  ;  isstar(X)),  ! 

X  \==  V, 

checkBinding (L, V) . 

checkBinding ( [X I L] , V)  isdelay (X),  !, 

dereference  (X,  X2,  [  ]  )  , 

(isdelay(X2)  -> 

makedelay (X2, checkBinding ( [X] ,  V) )  , 
checkBinding (L,V)  ; 
checkBinding ( (X2 I L] , V) ) . 
checkBinding ( [X  I L] , V)  atomic(X),  !, 
checkBinding (L, V) . 

checkBinding ( (X I L] , V)  compound (X),  !, 

X  [ _ IT] , 

checkBinding (T, V) , 
checkBinding (L, V) , 

findStatement (_#_,_)  !,  fail, 

f indstatement (_*_,_)  ! ,  fail. 

findStatement (P, H<-B) 
functor (P, F, N) , 
functor (H, F, N) , 

H  <-  B. 

findStatement (P, H<-B) 

findStatement (P, H<->B) . 
f indstatement (P, H<->B) 
functor (P, F, N) , 
functor (H, F,N) , 

H  <->  B. 

uni f yb (T1 , T2 , E) 

unifybl ( [Tl] ,  [T2] ,E)  . 
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unifybl ([],[],_)  : -  ! ■ 

unifybl ( [X  I Ll] ,  [ Y I L2] ,E) 
dereference  (X,  XI,  E)  , 
dereference  <Y,  Y1,E) , 
unifyb2 ( (XI ILI] , (Y1IL2],E) . 

unifyb2( [XILl] , [YIL2] ,E)  : -  var (X) ,  !, 

X=Y, 

unifybl  (L1,L2,E)  . 

unifyb2 ( (X  I Ll]  ,  [YIL2],E)  :-isscar(X),  !, 

(var (Y)  ->  X=Y  ; 
isstar(Y)  ->  X  ==  Y  ; 

(isdelay(Y),  binddelay ( Y, X) ) ) , 
unifybl  (L1,L2,E>  - 

unifyb2 ( [XILl] ,  [ Y I L2 ]  ,  E)  isdelay(X),  !, 

(var (Y)  ->  X=Y  ; 

isdelay ( Y)  ->  (X\==Y  ->  joindelay (X, Y) )  ; 
binddelay  (X,  Y)  )  , 
unifybl  <L1,L2,E)  . 

unifyb2 ( [XILl] , [YIL2] ,E)  :-atomic(X),  !, 

(var(Y)  ->  X=Y  ; 
isdelay (Y)  ->  binddelay (Y, X)  ; 
atomic (Y)  ->  X=Y  ; 
fail)  , 

unifybl (L1,L2,E)  . 

unifyb2 ( [XILl] , [ Y I L2] ,E)  compound (X) ,  !, 

(var (Y)  ->  (X=Y,  unifybl (Ll, L2, E) )  ; 
isdelay(Y)  ->  (binddelay (Y, X) ,  unifybl (Ll, L2,E) )  ; 
compound (Y)  -> 

(functor  (X,  F,  N) ,  functor  (Y,  F,  N)  , 

(X  [F I  SI ] ) ,  (Y  [F | S2 ] ) , 

append (SI, Ll,  Ml) ,  append (S2, L2 , M2) , 
unifybl (Ml, M2, E) )  ; 

fail)  . 

dereference  (X,  XI,  E) 

(var (X)  ->  X=X1  ; 
isstar(X)  -> 

(binding (X, E, X2)  ->  dereference (X2, XI, E) ;  X=X1)  ; 
isdelay (X)  -> 

(hasdelayvalue (X, V)  ->  dereference (V, XI, E) ;  X=X1)  ; 
X=X1)  . 

isstar(X)  nonvar(X),  X  =  *  (_)  . 

isdelay(X)  nonvar(X),  X=delay (_,_) . 

hasdelayvalue (delay (V, _), V2)  nonvar(V),  V=V2 . 

makedelay (delay (_, F) , X) 
appvar (F, [Xl_] ) . 

binddelay  (delay  (V,  F)  ,  V) 
calllist (F)  . 

calllist (E)  var (E) ,  ! . 
calllist ( [HIT] )  : - 

call (H) , 
calllist (T) . 

joindelay (delay (VI, Fl) , delay (V2, F2) )  Vl»deiay (V2, F2 ) , 
appvar  (F2,  Fl)  . 

/ *  not  in  use . . . 
clean(Dirty,  Clean) 

clean (Dirty,  0,  Clean,  _) . 
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clean  (Var,  Index,  Var,  Index)  var  (Var),  '. 

clean (delay (NonVar,  _) ,  Index,  NonVar,  Index)  nonvar (NonVar ) ,  !. 

clean (delay (S (IndexO) , DirtyGoals) ,  IndexO,  $ (IndexO) :CleanGoals,  Index) 
Indexl  is  Ir.dexG  +  1, 

clean (DirtyGoals,  Indexl,  CleanGoals,  Index). 

clean (DirtyTerm,  IndexO,  CleanTerm,  Index) 

Dirt yTerm= ..[FI DirtyArgs] , 

cleanlist (DirtyArgs,  IndexO,  CleanArgs,  Index), 

CleanTerm  =..  [F ICleanArgs] . 

cleanlist  ([],  Index,  [],  Index). 

cleanlist ( [Dirty  I DirtyArgs] ,  IndexO,  (Clean ICleanArgs] ,  Index) 
clean (Dirty,  IndexO,  Clean,  Indexl), 
cleanlist (DirtyArgs,  Indexl,  CleanArgs,  Index). 

portray (Dirty) 

\+  \+  (clean  (Dirty,  Clean),  write  (Clean)  )  . 

V 

unifyf  (T1,T2,E1,E2,D) 

unifyfl ( [Tl] ,  [T2] , El, E2, D)  . 

unifyfl  ((],(]  ,E,E,_)  !. 

unifyfl ( [XIL1] , [ Y I L2 ) , El, E2, D) 
dereference  (X,  XI,  El)  , 
dereference  (Y,  Yl,  El) , 
unifyf 2 ( [XI ILI] ,  [Yl |L2] ,E1,E2,D)  . 

unifyf2 ( (X ILI] , ( Y I L2] ,E1, E2, D)  var(X),  !, 

(isstar(Y)  ->  (E3=  (  (Y-X)  I  El] ,  unifyf  1  (Ll,  L2,  E3,  E2,  D)  )  ; 

(makedelay (X, D) ,  E2-fail)). 

unifyf2 ( [XIL1] , [YIL2] ,E1,E2,D)  isstar(X),  !, 

E3-[  (X-Y)  I  El]  ,  unifyfl  (L1,L2,E3,E2,  D)  . 

unifyf2 ( [X  I Ll ] ,  [ Y I L2 ] ,E1, £2, D)  isdelay(X),  !, 

(isstar(Y)  ->  (E3- I (Y=X)  I  El] ,  uni f y f 1 (Ll, L2 , E3 , E2 , D ) )  ; 

(makedelay (X, D) ,  E2=fail)). 

unifyf2( [XILl] , [YIL2] ,E1,E2,D)  s-atomic(X),  !, 

(atomic ( Y)  ->  (X==Y  ->  unifyf 1 (Ll, L2, El, E2, D) ;  E2=fail)  ; 
compound (Y)  ->  E2=fail  ; 

isstar(Y)  ->  (E3- [ (Y-X) IE1] ,  unifyf 1 (Ll, L2, E3, E2, D) )  ; 

(makedelay  (Y,  D)  ,  E2  =  faiit). 

unifyf2( [XILl] , [YIL2] ,E1,E2,D)  compound (X) ,  I, 

(compound (Y)  -> 

(( functor (X, F, N) ,  functor (Y, F, N) )  -> 

((X  =..  [F I  SI] ) ,  (Y  =..  [F I S2] ) , 
append (SI, Ll,  Ml) ,  append (S2, L2, M2) , 
unifyfl(Ml,M2,El,E2,D))  ; 

E2=fail)  ; 

atomic(Y)  ->  E2=fail  ; 

isstar(Y)  ->  (E3= [ (Y=X)  I  El] ,  unifyfl (Ll, L2, E3, E2, D) )  ; 

(makedelay  (Y, D) ,  E2  =  fail)). 

binding  (X,  (Y=T|_],T) 

X  —  Y,  . 

binding (X, (_IL],T) 
binding (X, L, T) . 

deref(X,E,T) 

binding  (X,E,T1)  ,  !, 

deref  (Tl,  E,  T)  . 

deref(X,  ,  X)  . 
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%  ut ilic  res 

rev (Li, L2)  :  - 

rev ( ! ] , LI , L2 ) . 
rev  (L,  [  ] ,  L)  . 
rev (LI, [X | L2] , L3) 

re v  (  [  X  I  LI  ] ,  L2 ,  L3 )  . 

apply_all (_,[])• 
apply_all <R, [XI Y] ) 
apply (R, [X] ) , 
apply_all (R,  Y) . 

appiy_all (_,_,(! )  !• 

apply_all (R,C,  [X  I Y] > 

apply (R,  [X, CJ  > ,  !, 
apply_all (R,C, Y)  . 

apply_either (R, C,  M,  [ X  I Y ] ) 

(apply  (R,  [ X, C, M] )  ; 
apply_either  (R,  C,  M,  Y)  )  . 

apply_or  (R,C,M,  (XI  Y]  ) 

(apply (R, (X,C,  Ml )  ; 

apply_or (R,C, M, Y) ) . 

apply_or (M,  [X  I Y] , E) 

(apply (M, [ X , E ] )  ; 
apply_ar  (M,  Y,  E)  )  . 

apply(R,Ts) 

X  =  .  .  (RITsl , 
call  (X)  . 

apply_list  (_,(],( 1  )  !. 

apply” li3t (R,  (Xl I  LI]  ,  [X2 I L2] ) 
apply (R, (XI, X2 ] ) ,  !, 

apply_l 1st (R,  LI ,  L2 )  . 

apply_list  (_,[],_,  (])  !. 

apply_list (R,  (XI ILI] ,C,  [X2 I L2 1 ) 
apply (R, [ XI , C , X2 ] ) , 
apply_list (R,L1,C,L2)  . 

apply_list(  ,[])  !■ 

apply_list (R,  (XI  I  LI ] , Cl,  C2 ,  [X2IL2]) 
apply (R, [ XI , Cl , C2,  X2 ] ) , 
apply_list (R, LI , Cl, C2 , L2)  . 

iterate  (_,( 1 ,  X,  X)  :  -  !. 
iterate  (R,  (XILJ,B,B2) 
apply (R, [X, B, B1 ] ) , 
iterate (R, L, Bl, B2) . 

/*  not  in  use  .  .  . 
flatten ((!,[])  s-  !  . 
flatten( [XIL1] ,L2) 
element (X) ,  ! , 

flatten (LI, L3) , 
union ( (X] , L3, L2)  . 
flatten ( [X I  LI] , L2)  : 
flatten (X, XI) , 
flatten (LI, L3) , 
union (XI, L3, L2)  . 

*/ 

element  (X)  \+  list(X). 
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list  (  []  )  . 
list ( [_|_] ) . 

compound (T) 

nonvar  (T) , 

\+  atomic (T) ,  ! . 

member (X,  [XI _ ] )  . 

member (X, [_| Z] )  member (X,Z). 

writel ( [ ] )  : -  ! . 
writel ( [X | L] )  : - 

nl,  write (X) ,  ! , 

write (L) . 

/*  replace (structure, oldv, newv, newstructure)  */ 

replace (N/0, X, N) 

0  ==  X,  !  . 
replace (_/_, X, X) 

(atomic (X)  ;  var(X)  ;  isstar(X)),  !. 
replace (N/0,S, SI) 
compound (S) , 

S  [FITS], 

apply_listl (replace, Ts,N/0, Tsl) , 

SI  .  [F | Tsl ] . 

apply_listl  (,[],_,  [])  !. 

apply_listl (R,  [XI I  LI ] ,C,  [X2 I L2 ] ) 
apply (R, [C, XI, X2 ] ) , 
apply_list 1 (R, LI, C, L2) . 

in (X,  Y)  :  - 
X  "  Y. 
in (P,  X)  :  - 

compound (P) , 

P  .  (_ I Ts] , 
apply_or ( in, Ts, X) . 

del  (_,  [],(]). 
del (X, [ Y | L] , LI) 

X==Y,  !, 

del  (X,  L,  LI)  . 
del (X, [YfLJ, [YIL1J) 
del(X,L,  LI)  . 

delete (LI, L2, L3) 

iterate (del, LI, L2, L3)  . 

head(H)  (atom(H)  ;  integer(H)  ;  functor  (H,  F,  _)  ,  F  \==  (:-)). 

append  ( [  ]  ,  L,  L)  . 
append ((XI  LI], L2,  [X  I L3] ) 
append  (LI,  L2, 1,3)  . 

appvar(X,L)  var(X),  ', 

X-L. 

appvar  (  [_  I  X] ,  L) 
appvar  (X,  L)  . 
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/*  my_builtin  -  INCOMPLETE  */ 

• 

my_builtin (sum ) . 
my_builtin  (diff  (_,_,_)  )  - 
my_builtin  (prod  (_,_,_)  )  . 
my_bui.lt  in  (quot  (_,_,_))  . 
my_builtin  (rem(_,_,_)  )  . 
my_builtin  (eq  (_,  _)  )  . 
my_bui  ltin  (ne  (_,  _)  )  . 

0  my_builtin  (gt  . 

my_builtin (ge (_,  _)  ) . 
my_builtin (le (_,_) ) . 
my_builtin (It (_,_) ) . 
my_builtin (atom (_) ) . 
my_builtin (int (_) ) . 
my_builtin  (var  (_)  )  . 
my_builtin (skel (_) ) . 

0  my_builtin  (op  . 

my_builtin (write (_) ) . 
my_builtin (ax (_,_) ) . 
my_builtin (delax (_) ) . 
my_builtin (fail) . 
my_builtin  ('=/'(_,_)). 


%  test  formula  set 

country (france)  <-  tt . 
country (spain)  <-  tt. 
country (Switzerland)  <-  tt . 
border (france,  Spain)  <-  tt. 
border (france,  Switzerland)  <-  tt. 
contain (europe,  france)  <-  tt. 

contain (europe,  C)  <-  country(C)  s  border(C,  france). 

teaches (r,  mmk)  <-  tt. 
teaches (r,  spv)  <-  tt . 
teaches (t,  lp)  <-  tt . 

lessl (a,  b)  <-  tt . 
lessl(b,  c)  <-  tt . 
lessl (c,  d)  <-  tt . 

less  (X,  Y)  <->  lessl  (X,  Y)  *  e  (Z,  lessl  (Z,  Y)  s  less  (X,  Z)  )  . 
lessall  (X,  L)  <->  a(Y,  listMember  (Y,  L)  «>  less  (X,  Y)  )  . 

unique  (X)  <->  a  (El,  a(E2,  listMember  (El,  X)  i  listMember  (E2,  X)  =>  El 

u(  [])  <->  tt. 

u  ( [X I L) )  <->  a  (E,  m(E,  L)  =>  E  =  X)  . 

ul  (  (]  )  <->  tt . 

ul( [XIL] )  <->  ul (X,  L) . 

ul (_,  [ ] )  <->  tt . 

ul (X,  [XIL])  <->  ul (X,  L) . 


m  (X,  L)  <->  e  (U,  e  (LI,  L  =  (U I  LI]  i  (  X  =  U  #  m(X,  LI)))), 
brother  (X,  Y)  <->  male(X)  S  sibling(X,  Y)  . 
uniqMember (X,  L)  <-> 

e(T,  L  =  [X I T]  &  (memberList  (X,  T)  =>  ff)  )  # 

e(T,  e(X2,  L  =  [X2|T]  i  (X  =  X2  =>  ff)  &  uniqMember  (X,  T)  )  )  . 

uniqUr.ion  (X,  Y,  Z)  <-> 

a (E,  uniqMember (E,  X)  #  uniqMember (E,  Y)  <->  uniqMember (E,  Z) ) . 
professor (X)  <->  X  »  r  #  X  *  t. 


E2 )  )  . 
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empioyeeList (D,  L)  <->  a(X,  employee (D,  X)  <->  listMember  (X,  L)  )  . 

employee (D,  X)  <->  # 

(D  =  cs  S  (X  =  r  #  X  =  s)  )  # 

<D  =  ts  S  (X  -  j  #  X  =  a) )  . 

el  (D,  L)  <->  a  (X,  em(D,  X)  <->  listMember  (X,  L)  )  . 
em(D,  X)  <-> 

(D  =  cs  S  X  =  s)  # 

(D  =  ts  S  X  =  a)  . 

listMember (_,  (])  <->  ff. 

listMember (X,  [UIR])  <->  X  *  U  #  listMember (X,  R) . 

mathMa jor (X)  <->  a(Y,  mathCourse ! Y)  =>  takes (X,  Y) ) . 
mathCourse (Z)  <->  Z  =  cl  #  Z  =  c3 . 
takes (X,  Y)  <-> 

(X  =  d  4  Y  =  c3)  # 

(X  =  j  &  Y  =  cl)  #  • 

(X  =  j  &  Y-  =  c3)  . 

subset (X,  Y)  <->  a (E,  listMember (E,  X)  =>  listMember (E,  Y) ) . 
equalSets  (X,  Y)  <->  subset  (X,  Y)  i  subset  (Y,  X). 
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%  op/3  directives 

op(900,  xfx,  <->) 
: -  op (890,  xfy,  =>) . 
op(880,  xfx,  <-) . 
op  (870,  xfy,  #)  . 
op (860,  xfy,  S) . 

: -  op  (500,  xfx,  : )  . 


ili .bench 


#  /* 

set-up. ili:  bench  set-up  for  ili 

V 

ili  : -  driver (ili) . 

benchmark ( ili,  run_ili,  run_dummy,  25). 

run_ili  q (_,  P) , 
sfP), 
fail . 

run_ili . 

run_dummy  : -  q (_,  P )  , 
dummy  (P)  , 
fail . 

run_dummy . 

show(ili)  :-  q(I,  R,  P)  , 

(s (P)  ->  R  =  provable  ;  R  =  unprovable) , 
write('Query  '),  write(I),  write(':  '),  write(P),  nl, 
write (success) ,  nl,  nl, 
fail . 

show (ili)  . 


♦include  "driver" 
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float ing_add .m 


#  /* 

f loating_add .m:  Pereira  benchmark  float ing_add  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  opt  ion (s)  :  $ _ OPTIONS _ S 

% 

%  floating  add 
% 

%  Fernando  C.  N.  Pereira 
% 

%  Do  IOC  fleeting  additions  nonrecursively, 

%  avoiding  obvious  compiler  optimizations. 

#if  BENCH 

#  include  ".floating  add. bench" 

#else 

floating_add  fal(0.1,  1.1,  R) . 

(tendif 

((option  DUMMY  “ 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (fal/3) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
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♦  /* 

integer_add.ni:  Pereira  benchmark  integer_add  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option  (s):  5 _ OPTIONS _ S 

% 

%  integer_add 
% 

%  Fernando  C.  N.  Pereira 
% 

%  Do  100  integer  additions  nonrecursi  vely, 

%  avoiding  obvious  compiler  optimizations. 

Uf  BENCH 

♦  include  ". integer_add. bench" 

#else 

integer_add  :-  al(0,  1,  R) . 

#endif 

♦  option  DUMMY  •' 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (al/3)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
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P) 

-  N 

is 

M 

+ 

K, 

a27 (N, 

27, 

P)  . 

a27(M,  X, 

P) 

-  N 

is 

M 

+ 

K, 

a28 (N, 

28, 

P)  . 

a28(M,  X, 

P) 

-  N 

is 

M 

+ 

K, 

a29 (N, 

29, 

PI  . 

a29(M,  X, 

P) 

-  N 

is 

M 

+ 

K, 

a30 (N, 

30, 

P)  . 

a30 (M,  X, 

P! 

-  N 

is 

M 

+ 

K, 

a31 (N, 

31, 

PI  . 

a31 (M,  X, 

P) 

-  N 

is 

M 

+ 

K, 

a32 <N, 

32, 

PI  . 

a32(M,  X, 

P) 

-  N 

is 

M 

+ 

X, 

a33 (N, 

33, 

P)  . 

a33(M,  X, 

P) 

-  N 

is 

M 

+ 

K, 

a34 (N, 

34, 

P)  . 

a34(K,  X, 

P) 

-  N 

is 

M 

K, 

a35 (N, 

35, 

P)  . 

a35 (M,  X, 

P) 

-  N 

is 

M 

+ 

K, 

a36  (N, 

36, 

P)  . 
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a36(M,  K 
a37(M,  K 
a38(M,  K 
a39  (M,  K 
a40 (M,  K 
a41 (M,  K 
a42 (M,  K 
a43(M,  K 
a44 (M,  K 
a45(M,  K 
a46(M,  K 
a47(M,  K 
a48(M,  X 
a49(M,  K 
a50  (M,  K 
a51(M,  K 
a52 (M,  K 
a53(M,  K 
a54 (M,  K 
a55(M,  K 
a56(M,  K 
a57(M,  K 
a58 (M,  K 
a59(M,  K 
a60(M,  K 
a61 (M,  K 
a62 (M,  K 
a63(M,  K 
a64 (M,  K 
a65 (M,  K 
a66(M,  K 
a67  (M,  K 
ab8(M,  K 
a69(M,  K 
a70 (M,  K 
a71 (M,  K 
a72(M,  K 
a73 (M,  K 
a74 (M,  K 
a75(M,  K 
a76(M,  K 
a77 (M,  K 
a78(M,  K 
a7  9  (M,  K 
a80 (M,  K 
a81(M,  K 
a82 (M,  K 
a83(M,  K 
a84  {M,  K 
a85 (M,  K 
a86 (M,  K 
a87  (M,  K 
a88 (M,  K 
a89  (M,  K 
a90(M,  K 
a91(M,  X 
a92(M,  K 
a93  (M,  K 
a94 (M,  K 
a95  (M,  K 
a96  (M,  K 
a97  {M,  X 
a98 (M,  K 
a99  (M,  K 
alOQ <M, 
lenctif 


integer_add .  m 


P) 

:  - 

N 

is 

M 

+ 

K, 

a37 (N,  37,  P)  . 

P) 

N 

is 

M 

+ 

K, 

a38  (N,  38,  P)  . 

P) 

:  - 

N 

is 

M 

+ 

K, 

a39  (N,  39,  ?)  . 

P) 

N 

is 

M 

+ 

K, 

a40 (N,  40,  P)  . 

P) 

:  - 

N 

is 

M 

+ 

K, 

a41  (N,  41,  P)  . 

P) 

N 

is 

M 

+ 

K, 

a42 <N,  42,  P)  . 

PI 

:  - 

N 

is 

M 

+ 

K, 

a43 (N,  43,  P)  . 

P) 

N 

is 

M 

+ 

K, 

a44 (N,  44,  P)  . 

P) 

:  - 

N 

is 

M 

+ 

K, 

a45 (N,  45,  P) . 

P) 

N 

is 

M 

+ 

K, 

a46  (N,  46,  P)  . 

PI 

N 

is 

M 

+ 

K. 

a47  (N,  47,  P). 

P) 

N 

is 

M 

+ 

K. 

a48 (N,  48,  PI  . 

P) 

;  - 

N 

is 

M 

K, 

a49  (N,  49,  P)  . 

P) 

N 

is 

M 

+• 

K, 

a50 (N,  50,  PI  . 

P) 

N 

is 

M 

+ 

K, 

a51  (N,  51,  P)  . 

p) 

N 

is 

M 

+ 

K, 

a52 (N,  52,  P)  . 

P) 

N 

is 

M 

■f 

K, 

a53 (N,  53,  PI  . 

P) 

:  - 

N 

is 

M 

+ 

K, 

a54 (N,  54,  P)  . 

P) 

:~ 

N 

is 

M 

K, 

a55  (N,  55,  P) . 

P) 

:  - 

N 

is 

M 

+ 

K, 

a56  (N,  56,  P)  . 

P) 

N 

is 

M 

+ 

K, 

a57 (N,  57,  P)  . 

P) 

N 

is 

M 

+ 

K, 

a5  8  (N,  58,  P)  . 

P) 

:  - 

N 

is 

M 

+ 

K, 

aS9  (N,  59,  P)  . 

P) 

N 

is 

M 

+ 

K, 

a60 (N,  60,  P|  . 

P) 

N 

is 

M 

+ 

K, 

a61  (N,  61,  P)  . 

P) 

N 

is 

M 

+ 

K, 

a62 (N,  62,  P)  . 

P) 

N 

is 

M 

+ 

K, 

a63 (N,  63,  P)  . 

P) 

N 

is 

M 

+ 

K, 

a64 (N,  64,  P)  . 

P) 

N 

is 

M 

+ 

K, 

a65  (N,  65,  P)  . 

P) 

N 

is 

M 

+ 

K, 

a66  (N,  66,  P)  . 

P) 

:  - 

N 

is 

M 

+ 

X, 

a67 (N,  67,  P)  . 

p) 

:  - 

N 

is 

M 

+ 

X, 

a68  !N,  68,  P)  . 

P) 

:  - 

N 

is 

M 

+ 

X, 

a69 (N,  69,  P)  . 

P) 

N 

is 

y 

+ 

X, 

a70 (N,  70,  P) . 

P) 

N 

is 

M 

4- 

X. 

a71(N,  71,  P)  . 

P) 

:  - 

N 

is 

M 

+ 

X, 

a72 (N,  72,  P)  . 

P) 

N 

is 

M 

+ 

X, 

a73 (N,  73,  P)  . 

P) 

N 

is 

M 

+ 

X, 

a74 (N,  74,  P)  . 

P) 

s- 

N 

is 

M 

+ 

X, 

a75 (N,  75,  P)  , 

P) 

N 

is 

M 

+ 

X, 

a7 6  (N,  76,  P)  . 

P) 

:  - 

N 

is 

M 

+ 

X, 

a77(N,  77,  P) . 

P) 

:  - 

N 

is 

M 

+ 

X, 

a78 (N,  78,  PI . 

P) 

:  - 

N 

is 

M 

+ 

K, 

a79  <N,  79,  PI  . 

P) 

N 

is 

M 

+ 

X, 

a80 (N,  80,  PI . 

P) 

N 

is 

M 

+ 

K, 

a81  (N,  81,  P)  . 

P) 

N 

is 

M 

+ 

X, 

a82(N,  82,  P)  . 

P) 

N 

is 

M 

+ 

X, 

a83 (N,  83,  P) . 

P) 

N 

is 

M 

+ 

X, 

a84 (N,  84,  PI  . 

P) 

:  - 

N 

is 

M 

+ 

X, 

a85 (N,  85,  P)  . 

P) 

N 

is 

M 

+ 

X, 

a86  (N,  86,  PI  . 

P) 

N 

is 

M 

+ 

X, 

a87 (N,  87,  P)  . 

P) 

:  - 

N 

is 

M 

+ 

X, 

a88 (N,  88,  PI  . 

P) 

N 

is 

M 

+ 

X, 

a89  (N,  89,  PI  . 

P) 

N 

is 

M 

+ 

X, 

a90  (N,  90,  P)  . 

P) 

N 

is 

M 

+ 

X, 

a91 (N,  91,  PI  . 

PI 

N 

is 

M 

+ 

X, 

a92 (N,  92,  PI  . 

P) 

N 

is 

M 

+ 

X, 

a93  (N,  93,  P)  . 

PI 

:  - 

N 

is 

M 

+ 

X, 

a94 (N,  94,  P) . 

P) 

N 

is 

M 

+ 

X, 

a95  (N,  95,  P). 

P) 

N 

is 

M 

+ 

X, 

a96  (N,  96,  P)  . 

P) 

:  - 

N 

is 

M 

+ 

X, 

a97 (N,  97,  P)  . 

P) 

N 

is 

M 

+ 

X, 

a98  (N,  98,  P)  . 

P! 

:  - 

N 

is 

M 

+ 

X, 

a99  (N,  99,  P)  . 

P) 

:  - 

N 

is 

M 

X, 

alOO (N,  100,  P) 

P) 

: 

-  E 

is  M 

X 
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arg_l  .m 


# 


% 

% 

% 

% 

% 

% 

% 

% 


/* 

arg  l.m:  Pereira  benchmark  (arg)  arg_l  master 
*/ 

generated:  _ MDAY _ MONTH _ YEAR _ 

option ( s) :  S _ OPTIONS _ $ 

(arg)  arg_l 

Fernando  C.  N.  Pereira 

100  calls  to  arg  at  position  1 


file 


# if  BENCH 

#  include  “ .arg_l .bench" 

#else 

arg_l  complex_nary_term(100,  1,  Term), 
argl  (1,  Term,  _)  . 

^  tendif 


tinclude  “arg" 


/*  code  for  arg  */ 
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arg  2.m:  Pereira  benchmark  (arg)  arg_2  master 

*/ 

%  generated:  _ MDAY _  _ MONTH _  _ YEAR _ 

%  option (s):  S _ OPTIONS _ S 

% 

%  (arg)  arg_2 

% 

%  Fernando  C.  N.  Pereira 
% 

%  100  calls  to  arg  at  position  2 

# if  BENCH 

#  include  " ,arg_2 .bench" 

((else 

arg_2  complex_nary_term(100,  2,  Term), 
argl (2,  Term,  _) . 

#endif 

((include  "arg"  /*  code  for  arg  */ 
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arg_4  .m 


arg  4.m:  Pereira  benchmark  (arg)  arg_4  master  file 

*/ 

%  generated:  _ MDAY _  _ MONTH _  _ _ YEAR _ 

%  option(s):  $ _ OPTIONS _ $ 

% 

%  (arg)  arg_4 
% 

%  Fernando  C.  N.  Pereira 

% 

%  100  calls  to  arg  at  position  4 

#if  BENCH 

♦  include  “ . arg_4 .bench" 

♦  else 

arg_4  complex_nary_term(100,  4,  Term), 
argl  (4,  Term,  _)  . 

*endif 

♦include  "arg"  /*  code  for  arg  */ 
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arg_8  .m 


*  /* 

arg_8.m:  Pereira  benchmark  (arg)  arg_8  master  file 

*/ 

%  generated:  _ MDAY _  _ MONTH _  _ YEAR _ 

%  option (s):  S _ OPTIONS _ $ 

% 

%  (arg)  arg_8 
% 

%  Fernando  C.  N.  Pereira 
% 

%  100  calls  to  arg  at  position  8 

#if  BENCH 

#  include  " .arg_8 .bench" 

♦else 

arg_8  complex_nary_term( 100 ,  8,  Term), 
argl  (8,  Term,  _)  . 

#endif 

♦include  ”arg"  /*  code  for  arg  */ 
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arg_16  .m 


arg_16.m:  Pereira  benchmark  (arg)  arg_16  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s) :  S _ OPTIONS _ $ 

% 

%  (arg)  arg_16 
% 

%  Fernando  C.  N.  Pereira 
% 

%  100  calls  to  arg  at  position  16 

#if  BENCH 

#  include  " . arg_16 . bench" 

#eise 

arg_16  complex_nary_term ( 100,  16,  Term), 

argl  (16,  Term,  _)  . 

*endif 

((include  "arg”  /*  code  for  arg  «/ 
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arg 


»  /* 

arg:  Pereira  code  for  100  calls  to  arg  at  position  N 
*/ 

complex_nary_term(0,  N,  N) 
complex_nary_term(I,  N,  Term) 

I  >  0,  J  is  I  -  1, 
complex_nary_term ( J,  N,  SubTerm) , 
nary_term(N,  SubTerm,  Term). 

nary_term(N,  SubTerm,  Term)  :- 
functor  (Term,  f,  N)  , 
f ill_nary_term (N,  SubTerm,  Term). 

f ill_nary_term (0,  _,  _)  . 

fill_nary_term(N,  SubTerm,  Term) 

N  >  0,  M  is  N  -  1, 
arg(N,  Term,  SubTerm), 
f ill_nary_term (M,  SubTerm,  Term). 

#option  DUMMY  ” 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (argl/3) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.” 
#if  DUMMY 

argl  (_,  _,  _)  . 

#else 

argl  (N,  T,  R)  arg(N,  T,  X),  arg2(N,  X,  R)  . 

arg2 (N,  T,  R)  arg(N,  T,  X),  arg3 (N,  X,  R) . 

arg3(N,  T,  R)  arg(N,  T,  X),  arg4  (N,  X,  R)  . 

arg4  (N,  T,  R)  arg(N,  T,  X),  argS  (N,  X,  R)  . 

arg5  (N,  T,  R)  arg(N,  T,  X),  arg6(N,  X,  R)  . 

arg6  (N,  T,  R)  arg(N,  T,  X),  arg7  (N,  X,  R)  . 

arg7  (N,  T,  R)  arg(N,  T,  X),  arg8  (N,  X,  R)  . 

arg8(N,  T,  R)  arg(N,  T,  X),  arg9(N,  X,  R)  . 

arg9  (N,  T,  R)  arg(N,  T,  X),  argl0(N,  X,  R)  . 

argl0(N,  T,  R)  arg(N,  T,  X),  argil  (N,  X,  R)  . 
argil  (N,  T,  R)  arg(N,  T,  X),  argl2(N,  X,  R)  . 

argl2  (N,  T,  R)  arg(N,  T,  X),  argl3(N,  X,  R)  . 

argl3 (N,  T,  R)  arg(N,  T,  X),  argl4  !N,  X,  R) . 

argl4 (N,  T,  R)  arg(N,  T,  X),  argl5 (N,  X,  R) . 

argl5 (N,  T,  R)  arg(N,  T,  X),  argl6(N,  X,  R) . 

argl6(N,  T,  R)  arg(N,  T,  X),  argl7 (N,  X,  R) . 

argl7(N,  T,  R)  arg(N,  T,  X),  argl8  (N,  X,  R)  . 

argl8  (N,  T,  R)  arg(N,  T,  X),  argl9(N,  X,  R)  . 

argl9  (N,  T,  R)  arg(N,  T,  X),  arg20(N,  X,  R)  . 

arg20  (N,  T,  R)  arg(N,  T,  X),  arg21(N,  X,  R)  . 

arg21  (N,  T,  R)  arg!N,  T,  X),  arg22  (N,  X,  R)  . 

arg22(N,  T,  R)  arg(N,  T,  X),  arg23(N,  X,  R)  . 

arg23(N,  T,  R)  arg(N,  T,  X),  arg24  (N,  X,  R)  . 

arg24  (N,  T,  R)  arg(N,  T,  X),  arg25  (N,  X,  R)  . 

arg25(N,  T,  R)  arg(N,  T,  X),  arg26(N,  X,  R)  . 
arg26  (N,  T,  R)  arg(N,  T,  X),  arg27(N,  X,  R)  . 

arg27  (N,  T,  R)  arg(N,  T,  X),  arg28  (N,  X,  R)  . 

arg28(N,  T,  R)  arg(N,  T,  X),  arg29(N,  X,  R)  . 

arg29(N,  T,  R)  arg(N,  T,  X),  arg30(N,  X,  R)  . 

arg30(N,  T,  R)  arg(N,  T,  X),  arg31(N,  X,  R)  . 

arg31  (N,  T,  R)  arg(N,  T,  X),  arg32(N,  X,  R)  . 

arg32 (N,  T,  R)  arg(N,  T,  X),  arg33  (N,  X,  R)  . 

arg33 (N,  T,  R)  arg(N,  T,  X),  arg34  (N,  X,  R) . 

arg34(N,  T,  R)  :-  arg(N,  T,  X),  arg35(N,  X,  R)  . 

arg35  (N,  T,  R)  arg(N,  T,  X),  arg36(N,  X,  R)  . 
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arg 

arg36(N,  T,  R)  arg(N,  T,  X),  arg37 (N,  X,  R)  . 

arg37<N,  T,  R)  arg(N,  T,  X),  arg38(N,  X,  R)  . 

arg38(N,  T,  R)  arg(N,  T,  X),  arg39(N,  X,  R)  . 

arg39  (N,  T,  R)  arg(N,  T,  X),  arg40  (N,  X,  R)  . 

arg40(N,  T,  R)  arg(N,  T,  X),  arg41  (N,  X,  R)  . 

arg41(N,  T,  R)  arg(N,  T,  X),  arg42 (N,  X(  R)  . 

arg42(N,  T,  R)  arg(N,  T,  X),  arg43(N,  X,  R>  . 

arg43  (N,  T,  R)  argtN,  T,  X),  arg44  (N,  X,  R)  . 

arg44  (N,  T,  R)  arg(N,  T,  X),  arg45  (N,  X,  R)  . 

arg45  (N,  T,  R)  arg(N,  T,  X),  arg46(N,  X,  R>  . 

arg46(N,  T,  R)  arg(N,  T,  X),  arg47  (N,  X,  R)  . 

arg47 (N,  T,  R)  arg(N,  T,  X),  arg48 (N,  X,  R) . 

arg48(N,  T,  R)  arg(N,  T,  X),  arg49(N,  X,  R)  . 

arg49(N,  T,  R)  arg(N,  T,  X),  arg50(N,  X,  R)  . 

argSO  (N,  T,  R)  arg(N,  T,  X),  arg51(N,  X,  R)  . 

arg51  (N,  T,  R)  arg(N,  T,  X),  arg52(N,  X,  R)  . 

arg52(N,  T,  R)  arg(N,  T,  X),  arg53(N,  X,  R)  . 

arg53(N,  T,  R)  arg(N,  T,  X),  arg54 (N,  X,  R)  . 


arg54 (N, 

T, 

R) 

arg(N, 

T,  X), 

arg55 (N, 

X, 

R)  . 

arg55 (N, 

T, 

R) 

arg(N, 

T,  X)  , 

arg56 (N, 

X, 

R)  . 

arg56 (N, 

T, 

R) 

arg(N, 

T,  X)  , 

arg57 (N, 

X, 

R!  . 

arg57 (N, 

T, 

R) 

arg(N, 

T,  X), 

arg58 (N, 

X, 

R)  . 

arg58 (N, 

T, 

R) 

arg  (N, 

T,  X), 

arg59 (N, 

X, 

R)  . 

arg59 (N, 

T, 

R) 

arg(N, 

T,  X), 

arg60  (N, 

X, 

R)  . 

arg60 (N, 

T, 

R) 

arg (N, 

T,  X), 

arg61 (N, 

X, 

R)  . 

arg61 (N, 

T, 

R) 

arg (N, 

T,  X), 

arg62 (N, 

X, 

R)  . 

arg62 (N, 

T, 

R) 

arg  (N, 

T,  X), 

arg63  <N, 

X, 

R)  . 

arg63 (N,  T,  R)  arg(N,  T,  X),  arg64  (N,  X,  R) . 

arg64 (N,  T,  R)  arg(N,  T,  X),  arg65(N,  X,  R) . 

arg65  (N,  T,  R)  arg(N,  T,  X),  arg66(N,  X,  R)  . 

arg66  (N,  T,  R)  arg(N,  T,  X),  arg67 (N,  X,  R)  . 

arg67(N,  T,  R)  arg(N,  T,  X),  arg68  (N,  X,  R)  . 

arg68  (N,  T,  R)  arg(N,  T,  X),  arg69(N,  X,  R)  . 

arg69(N,  T,  R!  arg(N,  T,  X),  arg70(N,  X,  R!  . 

arg70  (N,  T,  R)  arg  (N,  T,  X),  arg71  (N,  X,  R)  . 

arg71  (N,  T,  R)  arg(N,  T,  X),  arg72(N,  X,  Ri  . 

arg72(N,  T,  R)  arg(N,  T,  X),  arg73  (N,  X,  R)  . 

arg73  (N,  T,  R)  arg(N,  T,  X),  arg74  !N,  X,  R)  . 

arg74  (N,  T,  R)  arg(N,  T,  X),  arg75  (N,  X,  R)  . 

arg75 (N,  T,  R)  arg(N,  T,  X),  arg76(N,  X,  R) . 
arg76(N,  T,  R)  arg(N,  T,  X),  arg77  (N,  X,  R)  . 

arg77(N,  T,  R)  arg(N,  T,  X),  arg78  (N,  X,  R)  . 


arg78 (N, 

T, 

R) 

:  - 

arg (N, 

T,  X)  , 

arg79 (N, 

X< 

R)  . 

arg79  (N, 

T, 

R) 

arg (N, 

T,  X)  , 

arg80 (N, 

X, 

R)  . 

arg80 (N, 

T, 

R) 

arg (N, 

T,  X), 

arg81 (N, 

X, 

R)  . 

arg81  (N, 

T, 

R) 

:  - 

arg (N, 

T,  X), 

arg82 (N, 

X, 

R)  . 

arg82 (N, 

T, 

R) 

:  - 

arg (N, 

T,  X), 

arg83 (N, 

X, 

R)  . 

arg83  (N, 

T, 

R) 

:  - 

arg (N, 

T,  X), 

arg84 (N, 

X, 

R)  - 

arg84 (N, 

T, 

R) 

arg (N, 

T,  X), 

arg85 (N, 

X, 

R)  . 

arg85 (N, 

T, 

R) 

:  - 

arg (N, 

T,  X)  , 

arg86  (N, 

X, 

R)  . 

arg86 (N, 

T, 

R) 

arg (N, 

T,  X), 

arg87 (N, 

X, 

R)  . 

arg87 (N, 

T, 

R) 

:  - 

arg (N, 

T,  X), 

arg88 (N, 

X, 

R)  . 

arg88 (N, 

T, 

R) 

:  - 

arg (N, 

T,  X)  , 

arg89  (N, 

X, 

R)  . 

arg89 (N, 

T, 

R) 

:  - 

arg (N, 

T,  X), 

arg90 (N, 

X, 

R)  . 

arg90  (N, 

T. 

R) 

arg  (N, 

T,  X), 

arg91  (N, 

X, 

R!  . 

arg91 (N, 

T, 

R) 

:  - 

arg (N, 

T,  X), 

arg92 (N, 

X, 

R)  . 

arg92 (N, 

T, 

R) 

:  - 

arg (N, 

T,  X), 

arg93 (Nr 

X, 

R)  . 

arg93 (N, 

T, 

R) 

:  - 

arg (N, 

T,  X), 

arg94 (N, 

X, 

R)  . 

arg94 (N, 

T, 

R) 

:  - 

arg (N, 

T,  X), 

arg95 (N, 

X, 

R)  . 

arg95 (N, 

T, 

R) 

:  - 

arg (N, 

T,  X), 

arg96 (N, 

X, 

R)  . 

arg96  (N, 

T, 

R) 

arg  (N, 

T,  X), 

arg97 ;n. 

X, 

R)  . 

arg97 (N, 

T, 

R) 

:  - 

arg (N, 

T,  X), 

arg98 (N, 

X, 

R)  . 

arg98 (N, 

T, 

R) 

:  - 

arg (N, 

T,  X), 

arg99 (N, 

X, 

R)  . 

arg99 (N, 

T, 

R) 

:  - 

arg  (N, 

T,  X), 

arglOO (N 

X 

R) 

arglOO  (N,  T,  R)  arg(N,  T,  R)  . 
#endif 
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assert  unit.m 


#  /* 

assert_unit .m:  Pereira  benchmark  assert_unit  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s) :  S _ OPTIONS _ $ 

% 

%  assert_unit 

» 

%  Fernando  C.  N.  Pereira 
% 

%  Assert  1000  unit  clauses. 

#if  BENCH 

#  include  " .assert_unit . bench" 

#else 

assert_unit  abolish (ua,  3), 

create_units (1,  1000,  L) , 
assert_clauses (L) . 

#endif 

create_units (I,  N,  [])  I  >  N,  !. 
create_units  (I,  N,  [ua(K,  X,  f  (K,  X))  IRest]) 

K  is  I  *  (1  +  I//100) , 

J  is  I  +  1, 

create_units ( J,  N,  Rest). 

((option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (assert_clauses/l) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.” 
#if  DUMMY 

assert_clauses  (_)  . 

#else 

assert_clauses  (  (]  )  . 
assert_clauses ( [Clause IRest] ) 
assert (Clause) , 
assert_clause3 (Rest) . 

Oendif 
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access  unit.m 


#  /* 

access_unit .m:  Pereira  benchmark  access_unit  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _  _ YEAR _ 

%  option(s):  $ _ OPTIONS _ $ 

% 

%  access_unit 

% 

%  Fernando  C.  N.  Pereira 
% 

%  Access  100  (dynamic)  unit  clauses  with  1st  argument  instantiated. 
#if  BENCH 

♦  include  " .access_unit . bench” 

♦else 

access_unit  abolish (dix,  2), 

dix_clauses (1,  100,  L) , 
assert_clauses (L) , 
access_dix (1,  1). 

♦endif 

dix_clauses (I,  N,  [])  I  >  N,  !. 
dix_clauses (I,  N,  [dix(P,  Q)  I  L] ) 

I  =<  N, 

P  is  1*1, 

R  is  1  +  (I+N-2)  mod  N, 

Q  is  R*R, 

J  is  1  +  1, 
aix_clauses ( J,  N,  L) . 

assert_clauses  (  (] )  . 
assert_clauses ( [Clause  I  Rest] ) 
assert (Clause) , 
assert_clauses (Rest) . 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (access_dix/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.” 

♦if  DUMMY 

access_dix (_,  _) . 

♦else 

acces3_dix  (Start,  End) 
dix(Start,  Where), 

(  Where  -  End,  ! 

;  acce3s_dix (Where,  End) 

)  . 

♦endif 
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slow  access  unit.m 


♦  /* 

slow_access_unit .m:  Pereira  benchmark  slow_access_unit  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s) :  $ _ OPTIONS _ S 

% 

%  slow_access_unit 

% 

%  Fernando  C.  N.  Pereira 
% 

%  Access  100  dynamic  clauses  with  2nd  argument  instantiated. 

#if  BENCH 

♦  include  slow_access_unit . bench" 

#else 

slow_access_unit  abolish (dix,  2), 

dix_clauses (1,  100,  L) , 
assert_clauses (L) , 
access_back (1,  1). 

#endif 

dix_clauses (I,  N,  [])  I  >  N,  !. 
dix_clauses  (I,  N,  [dix(P,  Q)  |  L]  ) 

I  =<  N, 

P  is  1*1, 

R  is  1  +  (I+N-2)  mod  N, 

Q  is  R*R, 

J  is  I  +  1, 
dix_clauses (J,  N,  L) . 

assert_clauses  (  [] )  . 
assert_clauses ( [Clause  I  Rest] ) 
assert (Clause) , 
asseri_clausc3 (Rest)  . 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (access_back/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 

#if  DUMMY 

access_back (_,  _) . 

♦else 

acces3_back (Start,  End) 
dix (Where,  Start), 

(  Where  =  End,  ! 

;  access_back (Where,  End) 

)  . 

♦endif 
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shallowjbackt racking .m 


♦  /* 

shallow_backtracking.m:  Pereira  benchmark  shallow_backtracking  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s) :  $ _ OPTIONS _ S 

% 

%  shallow_backtracking 
% 

%  Fernando  C.  N.  Pereira 
% 

%  99  shallow  failures  (assumes  no  indexing  on  second  argument) . 

#if  BENCH 

♦  include  shallow_backtracking .bench" 

♦else 

shallow_backtracking  shallow. 

#endif 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (shallow/0) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 

#if  DUMMY 

shallow. 

♦halt 

♦endif 

shallow  b(_X,  100)  . 

♦include  "b" 
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deep  backt racking. m 


#  /* 

deep_backtracking.m:  Pereira  benchmark  deep_backtracking  master 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option ( s) :  S _ OPTIONS _ S 

% 

%  deep_backtracking 

% 

%  Fernando  C.  N.  Pereira 

» 

%  99  deep  failures. 


file 


#if  BENCH 

#  include  " ,deep_backtracking .bench” 
((else 

deep_backtracking  deep. 

#endif 


((option  DUMMY 


> 

> 

> 

> 

> 

> 

> 

> 

> 

> 

#if  DUMMY 
deep . 
#halt 
((endif 


To  facilitate  overhead  subtraction  for  performance 
statistics,  option  DUMMY  substitutes  a  'dummy'  for 
the  benchmark  execution  predicate  (deep/0) . 

To  use  this,  generate  code  without  DUMMY  and  run 
it,  generate  code  with  DUMMY  and  run  it,  and  take 
the  difference  of  the  performance  statistics. 

This  functionality  is  automatically  provided  with 
execution  time  measurement  when  BENCH  is  selected." 


deep  b(_X,  Y)  ,  Y  «  100. 


♦include  "b” 
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*  /* 

b:  (Pereira)  b/2  for  shallow_backtracking  and  deep_backtracking 

*/ 


b;_x,  i) . 

b(_X,  2)  . 
b  (_X,  3)  . 
b(_X,  4)  . 
b (_X,  5)  . 
b(_X,  6)  . 
b (_X,  7)  . 
b(_X(  8)  . 
b  (_X,  9)  . 
b(_X,  10)  . 
b  (_X,  11). 
b(_X,  12)  . 
b(_X,  13)  . 
b (_X,  14)  . 
b(_X,  15). 
b(_X,  16). 
b(_X,  17). 
b (_X,  18) . 
b(_X,  19). 
b  (_X,  20)  . 
b  (_X,  21)  . 
b  (_X,  22)  . 
b(_X,  23)  . 
b (_X,  24)  . 
b(_X,  25)  . 
b(_X,  26)  . 
b  (_X,  27)  . 
b(_X,  28)  . 
b(_X,  29). 
b(_X,  30) . 
b (_X,  31) . 
b(_X,  32). 
b(_X,  33)  . 
b(_X,  34)  . 
b(_X,  35). 
b(_X,  36)  . 
b(_X,  37). 
b  (_X,  38)  . 
b(_X,  39)  . 
b(_X,  40)  . 
b(_X,  41)  . 
b (_X,  42)  . 
b(_X,  43)  . 
b (_X,  44)  . 
b(_X,  45)  . 
b  (_X,  4  6)  . 
b  (_X,  47)  . 
b(_X,  48). 
b  (_X,  49)  . 
b (_X,  50)  . 
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• 

b 

b  (  X, 

51)  . 

b(  X, 

52)  . 

b  (  X, 

53)  . 

b  (  X, 

54)  . 

b  (  X, 

55)  . 

b(  X, 

56)  . 

b  (  X, 

57)  . 

b(  X, 

58)  . 

b  (  X, 

59)  . 

b  (  X, 

60)  . 

b<  X, 

61)  . 

b  (  X, 

62)  . 

b  (  X, 

63)  . 

b  (  X, 

64)  . 

b(~X, 

65)  . 

b  l_X, 

66)  . 

b  (  X, 

67)  . 

b  (  X, 

68)  . 

b  (  X, 

69)  . 

b  (  X, 

70)  . 

b  (  X, 

71)  . 

b  (  X, 

72)  . 

b  (  X, 

73)  . 

b<  X, 

74)  . 

b  (  X, 

75)  . 

b  (  X, 

76)  . 

b(  X, 

77)  . 

b  (  X, 

78)  . 

b(  X, 

79)  . 

b  (  X, 

80)  . 

b  (  X, 

81)  . 

b<  X, 

82)  . 

b  (  X, 

83)  . 

b<  X, 

84)  . 

b(_X, 

85)  . 

o(  X, 

66)  . 

b  (  X, 

87)  . 

b  (  X, 

88)  . 

b  (  X, 

89)  . 

b  (  X, 

90)  . 

b  (  X, 

91)  . 

b  (  X, 

92)  . 

b(  X, 

93)  . 

b  (  X, 

94)  . 

b  (  X, 

95)  . 

b(  X, 

96)  . 

b  (  X, 

97)  . 

b  (  X, 

98)  . 

b  (  X, 

99)  . 

b  (  X, 

100)  . 

1 
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tail  call  atom  atom.m 


#  /* 

tail_call_atom_atom.m:  Pereira  benchmark  tai l_cal l_atom_atom  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAH _ 

%  opt  ion ( s )  :  S _ OPTIONS _ S 

% 

%  tail_call_atom_atom 

% 

%  Fernando  C.  N.  Pereira 
% 

%  100  determinate  tail  calls 

#if  BENCH 

#  include  tail_call_atom_atom. bench" 

♦  else 

tail_call_atom_atom  pl(a). 

♦endif 

♦option  DUMMY  * 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  ( pi / 1 )  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.” 

#if  DUMMY 

pl  (_)  • 

♦else 

pl (a)  : -  p2 (a)  . 

p2 (a)  p3 (a)  . 
p3 (a)  p4 (a)  . 
p4 (a)  p5 (a)  . 
p5 (a)  p6 (a)  . 
p6  (a)  p7  (a)  . 
p7 (a)  p8 (a)  . 
p8 (a)  p9 (a) . 
p9 (a)  : -  plO  (a)  . 
plO (a)  pll (a)  . 

pll (a)  pl2  (a)  . 

pl2 (a)  pl3 (a) . 

pl3 (a)  pl4  (a)  . 

pi4  (a)  pl5  (a)  . 

pl5 (a)  pl6 (a)  . 

pl6 (a)  pl7 (a)  . 

pl7 (a)  pl8 (a)  . 

pl8 (a)  pl9 (a)  . 

pl9 (a)  p20 (a)  . 

p20 (a)  p21 (a) . 

p21 (a)  p22 (a)  . 

p22 (a)  p23  <a) . 

p23 (a)  p24 (a)  . 

p24 (a)  p25 (a)  . 

p25 (a)  p26 (a) . 

p26 (a)  p27 (a)  . 

p27 (a)  p28  (a) . 

p28  (a)  p29  (a)  . 

p29 (a)  p30 (a)  . 

p30  (a)  p31 (a)  . 

p31 (a)  p32  (a) . 

p32 (a)  p33  (a)  . 

p33  (a)  p34 (a)  . 

p34 (a)  p35 (a)  . 

p35 (a)  : -  p36 (a)  . 
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p36  (a) 
p37 (a) 
p38 (a) 
p39  (a) 
p40 (a) 
p41 (a) 
p42 (a) 
p43 (a) 
p44 (a) 
p45 (a) 
p4  6 (a) 
p47 (a) 
p48 (a) 
p49 (a) 
p50 (a) 
p51 (a) 
p52 (a) 
p53 (a) 
p54 (a) 
p55 (a) 
p56  (a) 
d57 (a) 
p58 (a) 
p59 (a) 
p60 (a) 
p61 (a) 
p62 (a) 
p63 (a) 
p64 (a) 
p65 (a) 
p66  (a) 
p67 (a) 
p68 (a) 
p69  (a) 
p70 (a) 
p71(a) 
p72 (a) 
p73(a) 
p7  4 (a) 
p75 (a) 
p7  6 (a) 
p77 (a) 
p78  (a) 
p79  (a) 
p80 (a) 
p81 (a) 
p82 (a) 
p83 (a) 
p84 (a) 
p8b (a) 
p86  (a) 
p87 (a) 
p88 (a) 
p89  (a) 
p90 (a) 
p91 (a) 
p92(a) 
p93 (a) 
p94 (a) 
p95 (a) 
p96  (a) 
p97 (a) 
p98 (a) 
p99 (a) 
plOO (a) 
fendif 
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p37 (a)  . 
p38 (a)  . 
p39  (a)  . 
p4 0  (a)  . 
p4 1  (a)  . 
p42 (a)  . 
p43 (a)  . 
p4 4  (a)  . 
p45 (a)  . 
p46 (a)  . 
p47 (a)  . 
p48  (a)  . 
p49(a)  . 
p50 (a)  . 
p51 (a)  . 
p52  (a)  . 
p53  (a)  . 
p54 (a)  . 
p55 (a)  . 
p56 (a)  . 
p57 (a)  . 
p58  (a)  . 
p59  (a)  . 
p60 (a)  . 
p61  (a)  . 
p62  (a)  . 
p63 (a)  . 
p64 (a)  . 
p65 (a)  . 
p66  (a)  . 
p67 (a)  . 
p68 (a?  . 

-  p69  (a)  . 

-  P70 (a) . 
p71(a)  . 
p72(a)  . 

-  p73 (a)  . 

-  p74 (a) . 

-  p75 (a)  . 

-  p76  (a)  . 

-  p77 (a)  . 

-  p78 (a)  . 
p79  (a)  . 
p80 (a)  . 

-  p81  (a)  . 
p82 (a)  . 
p83 (a)  . 

-  p84  (a)  . 
p85 (a)  . 
p8b (a)  . 

-  p87  (a)  . 
p88 (a)  . 
p89 (a) . 
p90 (a)  . 
p91 (a)  . 
p92 (a)  . 
p93 (a)  . 
p94 (a)  . 
p95 (a)  . 
p96  (a)  . 
p97 (a)  . 
p98 (a)  . 
p99  (a)  . 
plOO (a) 
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binary_call_atom_atom .m 


binary  call_atom_atom.m:  Pereira  benchmark  binary _call_atom_atom  master  file 
*/ 

%  generated:  _ MDAY _  _ MONTH _  _ YEAR _ 

%  option(s):  $ _ OPTIONS _ S 

% 

%  binary_call_atom_atom 

% 

%  Fernando  C.  N.  Pereira 
* 

%  63  determinate  nontail  calls,  64  determinate  tail  calls. 


#if  BENCH 

#  include  " .binary_call_atcm_atom. bench" 
#else 

binary_call_atom_atom  ql(a) . 

♦endif 


♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (ql/1) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 


#if  DUMMY 

ql  (_)  . 
♦else 
ql  (a) 
q2  (a) 
q3  (a) 
q4  (a) 


q2 (a) , 
q4 (a) , 
q6  (a)  , 
q8 (a) , 


q3  (a) 
q5  (a) 
q7  (a) 
q9  (a) 


q5  ( 

a) 

qlO  ( 

a)  , 

qll  ( 

a)  . 

q6  ( 

a) 

ql2! 

i)  , 

ql3( 

a)  . 

q7  ( 

a)  :  - 

ql4  ( 

a)  , 

ql5( 

a)  . 

q8  ( 

a) 

ql6( 

a)  , 

ql7< 

a)  . 

q9( 

a) 

ql8( 

a)  , 

ql  9  ( 

a)  . 

qlO 

(a) 

-  q20 

(a)  , 

q2 1 

(a) 

qll 

(a) 

-  q22 

(a)  , 

q23 

(a) 

ql2 

(a) 

-  q24 

(a)  , 

q25 

(a) 

qi3 

(a) 

-  q26 

(a). 

q27 

(a) 

ql  4 

(a) 

-  q28 

(a)  , 

q2  9 

(a) 

ql5 

(a) 

-  q30 

(a)  , 

q3 1 

(a) 

ql  6 

(a) 

-  q32 

(a)  , 

q33 

(a) 

ql7 

(a) 

-  q34 

(a)  , 

q35 

(a) 

ql8 

(a) 

-  q36 

(a)  , 

q37 

(a) 

ql9 

(a) 

-  q38 

(a)  , 

q3  9 

(a) 

q20 

(a) 

-  q40 

(a)  , 

q4 1 

(a) 

q2i 

(a) 

-  q42 

(a)  , 

q43 

(a) 

q22 

(a) 

-  q44 

(a)  , 

q45 

(a) 

q23 

(a) 

-  q46 

(a)  , 

q47 

(a) 

q24 

(a) 

-  q4  8 

(a)  , 

q4  9 

(a) 

q25 

(a) 

-  q50 

(a)  , 

q51 

(a) 

q26 

(a) 

-  q52 

(a)  , 

q53 

(a) 

q  27 

(a) 

-  q54 

(a)  , 

q55 

(a) 

q28 

(a) 

-  qS6 

(a)  , 

q5  7 

(a) 

q2  9 

(a) 

-  q58 

(a)  , 

q5  9 

(a) 

q30 

(a) 

-  q60 

(a) , 

q61 

(a) 

q31 

(a) 

-  q62 

(a)  , 

q63 

(a) 

q32 

(a) 

-  q64 

(a)  , 

q65 

(a) 

q33 

(a) 

-  q66 

(a)  , 

q67 

(a) 

q34 

(a) 

-  q68 

(a)  , 

q69 

(a) 

q35 

(a) 

-  q70 

(a)  , 

q71 

(a) 
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q36(a) 
q37 (a)  : - 

q38 (a)  : - 
q39(a) 
q40(a) 
q4 1 ( a )  : - 

q42  (a) 
q43(a) 
q44 (a) 
q45(a) 
q46(a)  :  - 
q47 (a)  : - 

q48(a) 
q4  9 (a) 
q50(a)  :  - 
q51 (a)  :  - 
q52 (a) 
q53(a) 
q54 (a)  : - 
q55 (a) 
q5  6 ( a )  :  - 
q57  (a) 
q58  (a)  : - 
q59 (a) 
q60(a) 
q61(a)  :  - 
q62 (a) 
q63(a) 
q64 (a)  . 
q65 (a)  . 
q66  (a)  . 
q67 (a)  . 
q68 (a)  . 
q69  (a)  . 
q70 (a)  . 
q71  (a)  . 
q72 (a)  . 
q7 3  (a)  . 
q74 (a)  . 
q75  (a)  . 
q76  (a)  . 
q77 (a,  . 
q78 (a)  . 
q7 9 (a)  . 
q80 (a)  . 
q81  (a)  . 
q82 (a)  . 
q83  (a)  . 
q84 (a)  . 
q85 (a)  . 
q86  (a)  . 
q87 (a)  . 
q88 (a) . 
q89 (a)  . 
q90 (a)  . 
q91 (a)  . 
q92  (a)  . 
q93 (a)  . 
q94 (a)  . 
q95  (a) 
q96  (a)  . 
q97 (a) . 
q98  (a)  . 
q99  (a)  . 
qlOO (a)  . 


q72 (a) ,  q73  (a)  . 
q74 (a) ,  q75 (a)  . 
q76 (a) ,  q77 (a)  . 
q78 (a) ,  q79  (a)  . 
q80  (a)  ,  q81  (a)  . 
q82 (a) ,  q83 (a)  . 
q84 (a) ,  q85 (a)  . 
q86  (a) ,  q87  (a)  . 
q88  (a) ,  q8 9  (a)  . 
q90  (a) ,  q91  (a)  . 
q92 (a) ,  q93 (a)  . 
q94 (a) ,  q95 (a)  .  - 
q96  (a)  ,  q97  (a)  . 
q98  (a) ,  q99 (a)  . 
qlOO (a) ,  qlOl  (a)  . 
ql02 (a) ,  ql03 (a)  . 
ql04 (a) ,  ql05 (a)  . 
ql06 (a) ,  q!07 (a) . 
ql08 (a) ,  ql09 (a)  . 
qllO  (a) ,  qlll (a)  . 
qll2 (a) ,  qll3 (a) . 
qll4 (a) ,  qll5 (a)  . 
qll6  (a)  ,  qll7  (a)  . 
qll8(a),  qll9 (a) . 
ql20  (a)  ,  ql2 X  (a)  . 
qi22 (a) ,  ql23 (a)  . 
ql24  (a)  ,  ql25  (a)  . 
q!26  (a)  ,  q!27  (a)  . 
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qlOl  (a)  . 
ql02 (a) . 
ql03 (a)  . 
ql04 (a)  . 
ql05 (a)  . 
ql06  (a)  . 
ql07  (a)  . 
ql08 (a)  . 
ql09  (a)  . 
qllO (a)  . 
qlll(a)  . 
qll2  (a)  . 
qll3 (a)  . 
q!14 (a)  . 
ql!5 (a)  . 
ql!6  (a)  . 
qll7 (a)  . 
qll8  (a)  . 
qll9U) . 
qX20 (a)  . 
ql2 1  (a)  . 
ql22 (a)  . 
ql23 (a)  . 
ql24 (a)  . 
ql25 (a)  . 
ql26 (a) . 
ql27  (a)  . 
#endi f 
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*  /* 

choice_point .m:  Pereira  benchmark  choice_point  master  file 
V 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s):  S _ OPTIONS _ S 

% 

%  choice_point 

% 

%  Fernando  C.  N.  Pereira 
% 

%  Create  100  choice  points  (assumes  no  clever  multi-predicate 


opt imizer ) . 


#if  BENCH 
#  include  " 
((else 

c’noice_point 
#endi f 


choice_point .bench" 


choice. 


((option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (choice/0). 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 


#if  DUMMY 

choice 

Kelse 

• 

choice 

cl (a) , 

cl  (a) 
cl (a)  . 

c2 (a)  . 

c2  (a) 
c2(a)  . 

: -  c3 (a)  . 

c3  (a) 
c3 (a)  . 

: -  c4 (a)  . 

c4  (a) 
c4  (a)  . 

c5 (a)  . 

c5  (a) 
c5 (a)  . 

c6  (a)  . 

c 6  (a) 
c6  (a)  . 

cl (a) . 

d  (a) 
d  (a)  . 

c8 (a) . 

c8  (a) 
c8  (a)  . 

c9 (a) . 

c9  (a) 
c9  (a)  . 

: -  clO (a)  . 

clO (a) 

ell (a) 

clO (a) 

ell (a) 

: -  cl2  (a) 

ell  (a) 

. 

cl2 (a) 

:  -  cl3 (a) 

cl2 (a) 

cl3 (a) 

cl4 (a) 

cl3 (a) 

. 

cl4 (a) 

: -  cl5 (a) 

cl4  (a) 

. 

cl5 (a) 

cl6(a) 

cl5 (a) 
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cl6  (a) 

c!7 (a)  . 

c!6 (a)  . 

cl7(a) 

c!8 (a)  . 

cl7  (a)  . 

cl8 (a) 

:  - 

c!9  (a)  . 

cX8  (a)  . 

c!9  (a) 

c20  (a)  . 

c!9 (a)  . 

c20 (a) 

c2 1  (a)  . 

c20 (a)  . 

c21 (a) 

:  - 

c22 (a)  . 

c21 (a)  . 

c22 (a) 

:  - 

c23 (a) 

c22 (a)  . 

c23 (a) 

c24 (a) 

c23  (a)  . 

c24 (a) 

:  - 

c25 (a) 

c24  (a)  . 

c25 (a) 

:  - 

c26  (a) 

c25 (a)  . 

c26  (a) 

c27  (a) 

c26 (a)  . 

c27 (a) 

:  - 

c28 (a) 

c27 (a) 

c28 (a) 

c29 (a) 

c28 (a) 

c29 (a) 

:  - 

c30 (a) 

c29 (a) 

c30 (a) 

:  - 

c31 (a) 

c30 (a) 

c31 (a) 

:  - 

c32 (a) 

c31 (a) 

c32 (a) 

:  - 

c33 (a) 

c32 (a) 

c33 (a) 

:  - 

c34 (a) 

c33 (a) 

c34 (a) 

:  - 

c35 (a) 

c34 (a) 

c35 (a) 

:  - 

c36 (a) 

c35 (a) 

c36 (a) 

:  - 

c37 (a) 

c36 (a) 

c37 (a) 

:  - 

c38 (a) 

c37 (a) 

c38 (a) 

:  - 

c39  (a) 

c38 (a) 

c39 (a) 

:  - 

c40 (a) 

c39  (a) 

. 

c40 (a) 

:  - 

c41 (a) 

c40 (a) 

c41 (a) 

c42 (a) 

c41 (a) 

c42 (a) 

:  - 

c43 (a) 

c42 (a) 

. 

c43  (a) 

:  - 

c44 (a) 

c43 (a) 

. 

c44 (a) 

:  - 

c45 (a) 

c44 (a) 

. 

c45 (a) 

:  - 

c46  (a) 

c45 (a) 

c46  (a) 

c47 (a) 

c46 (a) 

c47 (a) 

:  - 

c48 (a) 

c47 (a) 

c48 (a) 

c49  (a) 

c48 (a) 

c49 (a) 

:  - 

c50 (a) 

c4  9 (a) 

c50 (a) 

c51 (a) 

c50  (a ) 
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c51  (a) 

:  - 

c52 (a)  . 

c51  (a) 

c52 (a) 

:  - 

c53 (a)  . 

c52 (a) 

c53 (a) 

:  - 

c54 (a)  . 

c53 (a) 

c54 (a) 

:  - 

c55 (a)  . 

c54 (a) 

c55 (a) 

;  - 

c56 (a)  . 

c55 (a) 

c56  (a) 

:  - 

c57  (a)  . 

c56  (a) 

c57 (a) 

:  - 

c58 (a)  . 

c57 (a) 

c58 (a) 

:  - 

c59 (a)  . 

c58 (a) 

c59  (a) 

:  ~ 

c60  (a)  . 

c59  (a) 

c60 (a) 

c61 (a)  . 

c60 (a) 

c61 (a) 

o62  (a)  . 

c61  (a) 

c62 (a) 

:  - 

c63 (a)  . 

c62 (a) 

c63 (a) 

c64 (a) . 

c63 (a) 

c64 (a) 

:  - 

c65 (a) . 

c64  (a) 

c65 (a) 

:  - 

c66(a)  . 

c65 (a) 

c66  (a) 

:  - 

c67  (a)  . 

c66 (a) 

c67 (a) 

:  - 

c68  (a)  . 

c67 (a) 

c68 (a) 

:  - 

o69 (a) . 

c68 (a) 

c69  (a) 

c70 (a) . 

c69  (a) 

c70 (a) 

c71  (a)  . 

c70 (a) 

c71 (a) 

:  - 

c72  (a)  . 

c71 (a) 

c72 (a) 

:  - 

c73 (a)  . 

c72 (a) 

c73 (a) 

c74  (a)  . 

c73 (a) 

<'■’4  !ai 

c75 (a)  . 

c74 (a) 

c75 (a) 

:  - 

c7  6  (a)  . 

c75 (a) 

c76  (a) 

c77 (a) . 

c76  (a) 

c77 (a) 

c78 (a)  . 

c77 (a) 

c78 (a) 

:  - 

c79  (a)  . 

c78 (a) 

c79  (a) 

:  - 

c80  (a)  . 

c79  (a) 

c80 (a) 

c81  (a)  . 

c80 (a) 

c81 (a) 

:  - 

c82 (a)  . 

c81 (a) 

c82 (a) 

:  - 

c83  (a)  . 

c82 (a) 

c83 (a) 

:  - 

c84 (a)  . 

c83 (a) 

c84 (a) 

;  - 

c85  (a)  . 

c84 (a) 

c85 (a) 

:  - 

c86 (a)  . 

c85  (a) 
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c86  (a) 
c86 (a)  . 

!  “ 

c87 (a) 

c87 (a) 
c87  (a)  . 

I  “ 

c88 (a) 

c88 (a) 
c88  (a)  . 

•  " 

c89 (a) 

c89  (a) 
c89  (a)  . 

c 90 (a) 

c90 (a) 
c90 (a)  . 

‘  “ 

c91 (a) 

c91 (a) 
c91 (a)  . 

I  ” 

c92 (a) 

c92  (a) 
c92 (a)  . 

I  — 

c93 (a) 

c93 (a) 
c93 (a)  . 

•  — 

c94 (a) 

c94 (a) 
c94 (a)  . 

t  “ 

c95 (a) 

c95 (a) 
c95 (a) 

t  * 

c96  (a) 

c96  (a) 
c96  (a)  . 

5  ~ 

c97(a) 

c97 (a) 
o97 (a) 

!  “ 

c98 (a) 

c98  (a) 
c98 (a) 

I 

c99  (a) 

c99 (a) 
c99 (a) 

I  ~ 

d  ^0  <* 

clOO (a) 

c 100 (a) 
#endif 

• 
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#  /* 

trail_variables .m:  Pereira  benchmark  trail_variables  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s) :  S _ OPTIONS _ S 

% 

%  trail_variables 

% 

%  Fernando  C.  N.  Pereira 
% 

%  Create  100  choice  points  and  trail  100  variables. 

#if  BENCH 

#  include  " .trail_variables .bench" 

#else 

trail_variables  trail. 

#endif 

#option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (trail/0)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 

#if  DUMMY 

trail . 

#else 


trail 

tl(_X), 

tl  (a) 
tl  (b)  . 

t2 ( _ X) . 

t2  (a) 
t2(b)  . 

t3 (_X) . 

t3  (a) 
t3 (b)  . 

t4  (_X)  . 

t4  (a) 
t4 (b)  . 

t5 (_X) . 

t5  (a) 
t5 (b)  . 

1 6 ( _ X )  . 

16(a) 

1 6 (b)  . 

t7 (_X) . 

t7  (a) 
t7 (b)  . 

t8 (_X) . 

t8  (a) 
t8 (b)  . 

t9 ( _ X ) . 

t9  (a) 
t9(b)  . 

tlO (_X) . 

tlO (a) 

tll(_X) 

tlO (b) 

til  (a) 

tl2  (_X) 

til (b) 

tl2 (a) 

tl3  (_X) 

t 12 (b) 

tl3  (a) 

tl4 (_X) 

tl3  (b) 

. 

1 14  (a) 

1 15  ( _ X ) 

tl4 (b) 

. 

tl5 (a) 

tl6  ( _ X) 

t 15 (b) 
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tl6  (a) 

1 17 (_X)  . 

tl6 (b)  . 

t!7 (a) 

tl8 (_X) 

tl7 (b)  . 

t 18 (a) 

:  - 

tl9 { _ X 

tl8 (b)  . 

tl9  (a) 

t20  (  X) 

tl9  (b)  . 

t20 (a) 

t21  { _ X) 

t20  (b)  . 

t21 (a) 

t22  (_X) 

t21  (b)  . 

t22 (a) 

:  - 

t23  (_X) 

t22 (b) . 

t23 (a) 

t24 (_X) 

t23 (b) . 

t24 (a) 

t25 (_X) 

t24  (b)  . 

t25 (a) 

t26  (  X) 

t25 (b)  . 

t26  (a) 

:  - 

t27 (_X) 

t26  (b)  . 

t27 (a) 

:  - 

t28 (_X) 

t27 (b) 

t28 (a) 

:  - 

t29  ( _ X) 

t28  (b) 

t29  (a) 

t30 (_X) 

t29  (b) 

t30  (a) 

:  - 

t31 ( _ X ) 

t30 (b) 

t31  (a) 

:  - 

t32 (_X> 

t31  (b) 

t32 (a) 

:  - 

t33  (_X) 

t32 (b) 

t33 (a) 

t34 (_X) 

t33 (b) 

t34 (a) 

:  - 

t35 (_X) 

t34 (b) 

C3S  (a) 

t36(_X) 

t35  (b) 

t36  (a) 

:  - 

t37 (_X) 

t36  (b) 

t37 (a) 

:  - 

t38 (_X) 

C37 (b) 

t38 (a) 

t39  ( _ X) 

t38 (b) 

t39  (a) 

:  - 

t40 ( _ X ) 

t3  9 (b) 

t40 (a) 

1 4 1  ( _ X ) 

t40  (b) 

t41 (a) 

t42 (_X) 

t41  (b) 

t42 (a) 

t43  ( _ X) 

t42 (b) 

t43 (a) 

t44 (_X) 

t43 (b) 

t44 (a) 

:  - 

t45 (_X) 

t44 (b) 

t45 (a) 

:  - 

t46  < _ X) 

t45  (b) 

t46 (a) 

t47 (_X) 

t46 (b) 

t47  (a) 

t48  (_X) 

t47 (b) 

t48 (a) 

:  - 

1 4  9 ( _X ) 

t48 (b) 

. 

t49 (a) 

:  - 

t50  (  X) 

.  a  r\  > 

t50 (a) 

:  - 

t51 <_X) 

t50 (b) 

. 
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tSKa) 
t51  (b) 

:  - 

t52 (_X) 

t52 (a) 
t52 !b) 

!  “ 

C53 (_X) 

t53 (a) 
t53  (b) 

:  - 

t54 (_X) 

t54 (a) 
t54 (b) 

:  ~ 

t55 (_X) 

t55 (a) 
t55  (b) 

!  ” 

C56(_X) 

t56  (a) 
t56(b) 

!  “ 

t57  (_X) 

t57 (a) 
t57 (b) 

:  ~ 

t58 (_X) 

t58 (a) 
c58 (b) 

i  — 

t5  9 (_X) 

t59  (a) 
t59(b) 

i  ~ 

t60  (_X) 

t60 (a) 

1 60 (b) 

5  “ 

t61  (_X) 

t61  (a) 
t61  (b) 

I  “ 

t62  (_X) 

t62  (a) 
t62  (b) 

l  — 

1 63 (_X) 

t63  (a) 
t63  (b) 

5  - 

1 64 <_X) 

t64 (a) 
t64  (b) 

: — 

t65  (_X) 

t65  (a) 
t65  (b) 

:  - 

t66  <_X) 

t66  (a) 
t66  (b) 

•  ~ 

t67  (_X) 

t67  (a) 
C  67 (b) 

i  ~ 

1 68 ( _ X) 

t68  (a) 
t68  (b) 

!  “ 

1 69  ( _ X) 

C69  (a) 
t69  (b) 

I  - 

1 70 (_X) 

t70 (a) 
t70  (b) 

!  _ 

t71 ( _ X ) 

t71  (a) 
1 71 (b) 

S  — 

t72 (_X) 

t72 (a) 
t72 (b) 

•  ~ 

t73 (_X) 

t73 (a) 
t73 (b) 

'  “ 

t74(_X) 

t74  (a) 
t74  (b) 

I  “ 

t75(_X) 

t75  (a) 
t75(b) 

: - 

t76 ( _ X ) 

t76  (a) 
t76  (b) 

•  ~ 

1 77  (_X) 

t77  (a) 
t77  (b) 

:  — 

t78 (_X) 

t78  (a) 
1 78  (b) 

:  ■ 

t79 (_X) 

t79(a) 
t79 (b) 

•  — 

t80  (_X) 

t80 (a) 
t80 (b) 

i  ~ 

t81 ( _ X ) 

t81  (a) 
t81 (b) 

•  ~ 

t82 (_X) 

t82  (a) 
t82 (b) 

•  ~ 

t83 (_X) 

t83  (a) 
t83 (b) 

!  - 

t84 (_X) 

C84  (a) 
t84 (b) 

-  “ 

t85  (_x; 

t85  (a) 
t85 (b) 

S  * 

1 8  6  { _ X ) 
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t86  (a)  :  - 
t86(b)  . 
t87  (a!  : - 
t87 (b)  . 
t88  (a)  :  - 
t88 (b)  . 
c89  (a) 
t89  (b)  . 
t90 (a) 
t90  (b)  . 
t91  (a)  :  - 
t91  (b)  . 
c92 (a)  : - 
t92  (b)  . 
c93  (a)  : - 
t93 (b) . 
t94 (a)  : - 
t94  (b)  . 
t95 (a)  : - 
t95 (b) . 
t96  (a)  :  - 
t96  (b)  . 
t97  (a)  :  - 
t97 (b)  . 
t98 (a) 
t98  (b)  . 

1 99(a)  :  - 
t99  (b)  . 
tlOO (a) . 
tlOO  (b)  . 
#endif 


t87  (_X)  . 
C88 <_X) . 

c89 ( _ X )  . 

1 90  (_X)  . 
C91 (_X)  . 
C92  (_X)  . 
t93  (_X)  . 
1 94 (_X)  . 
C95  (_X)  . 

t96  ( _ X)  . 

1 97 (_X>  . 
1 98 (_X)  . 

t99  ( _ X)  . 

tlOO(  X) 
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#  /* 

index. m:  Pereira  benchmark  index  master  file 

*/ 

%  generated:  _ MDAY _  _ MONTH _  _ YEAR _ 

%  option  (s):  S _ OPTIONS_$ 

% 

%  index 

% 

%  Fernando  C.  N.  Pereira 

% 

%  ln0  first-argument-determinate  calls;  some  systems  may 
%  need  extra  declarations  to  index  on  the  first  argument. 

#if  BENCH 

#  include  ". index. bench" 

#else 

index  : -  ix ( 1 )  . 
ffendif 

Ooption  DUMMY  •' 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (ix/1)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.1 
#if  DUMMY 

ix (_) . 

#else 

ix (1)  :-  ix(10000) . 

ix  (4)  . 

ix(9)  :-  ix(4)  . 
ix (16)  ix (9)  . 

ix  (25)  ix  (16)  . 

ix  (36)  ix  (25)  . 

ix  (49)  ix  (36)  . 

ix  ( 64 )  :-  ix  (4  9)  . 
ix(81)  :-  ix(64)  . 
ix (100)  :-  ix (81) . 
ix ( 121)  :-  ix (100)  . 
ix (144)  :-  ix(121) . 
ix (169)  :-  ix (144) . 
ix  (196)  :-  ix (169)  . 
ix (225)  :-  ix(196)  . 
ix  (256)  :-  ix(225)  . 
ix  (289)  :-  ix(256)  . 
ix  (324)  :-  ix(289)  . 
ix (361)  :-  ix (324)  . 
ix  (400)  :-  ix  (361)  . 
ix (441)  :-  ix (400)  . 
ix ( 484 )  :-  ix(441)  . 
ix  (529)  :-  ix(484)  . 
ix (5 76)  :-  ix(529)  . 
ix (625 )  : -  ix (57  6)  . 
ix (676)  :-  ix(625)  . 
ix (729)  :-  ix<676)  . 
ix  (784 )  :-  ix(729)  . 
ix (841)  :-  ix (784)  . 
ix ( 900)  :-  ix (841)  . 
ix (961)  :-  ix ( 900)  . 
ix (1024)  :-  ix (961)  . 
ix ( 1089)  :-  ix ( 102  4 )  . 
ix (1156)  :-  ix (108  9)  . 
ix  ( 1225 )  :-  ix ( 1156)  . 
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ix  (1296)  :  - 
ix  (1369)  :  - 
ix ( 1444 )  : - 
ix (1521) 
ix (1600)  : - 
ix (1681) 
ix ( 17  64 )  : - 
ix (1849)  : - 
ix (1936)  : - 
ix (2025 )  :  - 

ix(2116) 
ix  (2209) 
ix  (2304)  : - 

ix  (2401)  :  - 
ix (2500)  : - 

ix  (2601)  :  - 

ix (2704)  : - 
ix  (2809)  :  - 
ix (2916) 
ix (3025)  : - 
ix(3136) 
ix  ( 324  9) 
ix (3364 ) 
ix (3481) 
ix (3600)  : - 
ix (3721 ) 
ix (3844 )  : - 
ix  (3969)  :  - 
ix  (4096)  : - 
ix  (4225) 
ix  (4356) 
ix (4489)  : - 
ix (4624) 
ix (4  761 ) 
ix (4900) 
ix (5041) 
ix (5184)  :  - 
ix  (5329) 
ix(5476)  :  - 
ix  (5625)  :  - 
ix  (577 6)  :  - 
ix  (5929)  :  - 
ix ( 6084 ) 
ix (6241)  : - 
ix (6400) 
ix(6561) 
ix (6724 )  :  - 
ix  (6889)  :  - 
ix  (7056)  :  - 
ix (7225)  : 
ix  (7396)  : 
ix  (7569)  : 
ix ( 7744 )  : 
ix (7921)  : 
ix (8100)  : 
ix (8281)  : 
ix ( 84  64 )  : 
ix (8649)  : 
ix  (8836)  : 
ix (9025)  : 
ix  (9216)  : 
ix (9409)  : 
ix  ( 9604 )  : 
ix (9801)  : 
ix(10000) 
#endi f 


ix (1225)  . 
ix  (1296)  . 
ix  (1369)  . 
ix ( 1444 )  . 
ix (1521)  . 
ix (1600)  . 
ix (1681)  . 
ix (1764)  . 
ix (184 9)  . 
ix (1936)  . 
ix (2025)  . 
ix  (2116)  . 
ix  (2209)  . 
ix (2304)  . 
ix  (2401)  . 
ix (2500 )  . 
ix  (2601)  . 
ix (2704) . 
ix  (2809)  . 
ix  (2916)  . 
ix (3025 ) . 
ix  (3136)  . 
ix  (3249)  . 
ix (3364)  . 
ix  (3481)  . 
ix (3600)  . 
ix  (3721)  . 
ix (3844 ) . 
ix (3969) . 
ix  (4096)  . 
ix (4225) . 
ix  (4356)  . 
ix (4489)  . 
ix (4624) . 
ix ( 4761 ) . 
ix (4900) . 
ix  (5041)  . 
ix (5184)  . 
ix  (5329)  . 
ix  (5476)  . 
ix  (5625)  . 
ix  ( 577 6)  . 
ix  (5929)  . 
ix ( 6084 )  . 
ix (6241)  . 
ix (6400)  . 
ix (6561)  . 
ix (6724 )  . 
ix  ( 6889)  . 
ix  (7056)  . 
ix (7225)  . 
ix  (7396)  . 
ix  (7569)  . 
ix (7744)  . 
ix  (7921)  . 
ix  (8100)  . 
ix  (8281)  . 
ix  (8464)  . 
ix  (8649)  . 
ix  (8836)  . 
ix ( 9025)  . 
ix (9216)  . 
ix  (94  0  9)  . 
ix ( 9604 )  . 
-  ix (9801) 


I 
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#  /* 

cons_list.m:  Pereira  benchmark  cons_list  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option(s):  $ _ OPTIONS _ $ 

% 

%  cons_list 

% 

%  Fernando  C.  N.  Pereira 

% 

%  Construct  a  100  element  list  nonrecursiveiy . 

♦  if  BENCH 

♦  include  cons_l ist .bench" 

#else 

cons_list  rl (_) . 

♦endif 

♦option  DUMMY  ” 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (rl/1) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.” 
#if  DUMMY 

rl (_) . 

♦halt 

♦endif 

♦include  "rl" 
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*  /* 

waik_Iist.m:  Pereira  benchmark  waik_Iist  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _  _ YEAR 

%  option (s) :  S _ OPTIONS _ 3 

% 

%  walk_list 
% 

%  Fernando  C.  N.  Pereira 

% 

%  Walk  down  a  100  element  list  nonrecurs i veiy . 

#if  BENCH 

♦  include  " .walk_ list .bench" 

♦  else 

walk_list  rl (L) , 
wl(L). 

#endif 

♦include  "rl" 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (wl/1) . 
s 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
♦if  DUMMY 

win . 

♦halt 

♦endif 

wl  (  [  1 1 R]  )  r2(R)  . 
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♦  /  * 

walk  list  rec.m:  Pereira  benchmark  wa lk_l istrec  masher  fi 

*  / 

%  generated:  _ MCAY _ MONTH _ YEAR _ 

%  option (s) :  S _ OPTIONS _ S 

% 

%  walk_l ist_rec 
% 

♦  Fernando  C.  N.  Pereira 
i 

%  Walk  down  a  100  element  list  recursively. 

♦  if  3ENCH 

♦  include  " .walk_list_rec.bencn" 

♦  else 

walk  list  rec  rl (L) , 


♦include  ”rl" 


♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (wlr/1) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functions -ity  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected, 
♦if  DUMMY 

wlr  (_)  . 

♦  halt 
♦endif 

%  recursive  list  cruncher 
wlr  (  I ) )  . 

wlr ( !_ 1 L] )  : -  wlr (L)  . 
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♦  /* 

args_2.m:  Pereira  benchmark  (args)  args_2  master  file 
V 

%  generated:  _ MDAY _  _ MONTH _ YEAR _ 

%  option (s) :  S _ OPTIONS _ S 

% 

%  (args)  args_2 
% 

%  Fernando  C.  N.  Pereira 
% 

%  Walk  down  2  copies  of  the  same  100  element  list  recursively. 

♦  if  3ENCH 

♦  include  args_2 . bench" 

♦  else 

args_2  : -  rl (L) , 

args (2,  L)  . 

fendif 

♦include  "rl" 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (args/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 

♦if  DUMMY 

args (_,  _) . 

♦  halt 
♦endif 

args(2,  L)  wlr  (L,  L)  . 
wlr  (  t],  []  )  . 

wlr ( [_ I  LI ] ,  [_ I L2 1 )  wlr(Ll,  L2)  . 


pereira  *37 


args_4 .m 


♦  /* 

args_4.m:  Pereira  benchmark  (args)  args_4  master  file 

«/ 

%  generated:  _ MDAY _  _ MONTH _  _ YEAR _ 

%  option (s) :  S _ OPTIONS _ S 

% 

%  (args)  args_4 
% 

%  Fernando  C.  N.  Pereira 
% 

%  Walk  down  4  copies  of  the  same  100  element  list  recursive 
#if  BENCH 

♦  include  " .args_4 -bench" 

♦  else 

args_4  : -  rl (L) , 

args  (4,  L)  . 

#endif 

((include  "rl" 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (args/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
♦if  DUMMY 

args  (_,  _)  . 

♦halt 

♦endif 

args(4,  L)  wlr(L,  L,  L,  L)  . 
wlr((],  [],  [],  []). 

wlr ( (_ I  LI ] ,  [_ I L2 ] ,  [_ I L3 ) ,  (_IL4])  :-wlr'Ll,  L2,  L3,  L4). 
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♦  /* 

args_8.m:  Pereira  benchmark  (args)  args_8  master  fixe 

"/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s ) :  S _ OPTIONS _ S 

% 

%  (args)  args_8 

% 

%  Fernando  C.  N.  Pereira 

% 

%  Walk  down  8  copies  of  the  same  100  element  list  recursively. 

♦  if  BENCH 

♦  include  " . args_8 . bench" 

♦else 

args_8  : -  rl (L) , 

args  (8,  L)  . 

#endif 

#include  ”rl“ 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (args/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 

♦if  DUMMY 

args (_,  ) . 

♦halt 

♦endif 

args  (8,  L)  wlr(L,  L,  L,  L,  L,  L,  L,  L)  . 

wir < n ,  [],  n,  [),  n.  n,  n,  n>. 

wlr ( [  ILl),  (  I L2 ] ,  C 1 L  3 ] ,  [_IL4],  (_iL5],  i_IL6],  [_IL7],  I L8 ] ) 

wlr (LI,  L27  L3,  L4,  L5,  L6,  L7,  L8)  . 
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♦  /* 

args_16.m:  Pereira  benchmark  (args)  args_16  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  opt  ion ( s)  :  S _ OPTIONS _ S 

% 

%  (args)  args_16 

% 

%  Fernando  C.  N.  Pereira 
% 

%  Walk  down  16  copies  of  the  same  100  element  list  recursively. 

♦  if  BENCH 

♦  include  args_16 .bench" 

♦else 

args_16  : -  rl (L) , 

args  (16,  L)  . 

#endif 

♦include  "rl" 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (args/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 

♦if  DUMMY 

args (_,  _) . 

♦halt 
♦end if 

args  (16,  L)  :  ~  wlr  (L,  L,  L,  L,  L,  L,  L,  L ,  L,  L,  L,  L,  L ,  L,  L,  L)  « 

wlr  (  [  ]  ,  [],  (],  U,  [],  (],  [],  (],  (],  [],  [],  (],  (],  (],  (),  (]). 

wlr ( [_ | LI ) ,  [_ I L2 ] ,  [_ | L3  3 ,  [_IL4],  t_IL5],  [_IL61,  I_IL7],  [  |L8], 

[_ I L9] ,  (_ | L10 ] ,  [_IL11],  l  IL12],  [_ I L13  3 ,  ML14),  [_IL15],  [_IL16]) 
wlr  (LI,  L2,  L3,  L4,  L5,  L6,  L7,  L8,  L9,  L1C,  Lll,  L12,  L13,  L14,  L15,  L16)  . 
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#  /* 

rl:  (Pereira)  nonrecursive  list  cruncher 
*/ 

%  nonrecursive  list  cruncher 


rl ( [1 IRJ )  : 
r  2  ( [  2  I R] )  : 

r3 ( [3 IR] )  : 

r4 ( [ 4  I R] )  : 

r5 ( [5 |R] )  : 

r6 ( ( 6 IR] )  : 

r7([7|R])  : 

r8 ( ( 8  I R] )  : 

r9 ( [ 9  I R] )  : 

rlO ( [10  I R] ) 
rll ( [ 11 1 R] ) 
2-12  (  [12  |R]  > 
rl3 ( [13  |R]  ) 
rl4 ( [14  IR]  ) 
rlS ( [  15  |  R]  ) 
rl6 ( [16 IR] ) 
rl7 ( [17 |R] ) 


r2 (R)  . 
r3  (R)  . 
r4 (R)  . 
r5(R)  . 
r6 (Rl . 
r7 (R)  . 
r8 (R)  . 
r 9 (R)  . 
rlC (R)  . 

-  rll  (R)  . 

-  rl2 (R)  . 

-  rl3 (R)  . 

-  rl4 (R)  . 

-  rl5 (R)  . 

-  rl6 (Rl . 

-  rl7  (R)  . 

-  rl8 (R)  . 


rl8 ( ( 18 | R] ) 
r 19 ( [ 19 | R] ) 
r20 ( [20 | R] ) 
r21 ( [21 | R] ) 
r22 ( [22 IR] ) 
r23 ( [23  I R] ) 
r24 ( [24  I R] ) 
r25 ( [25  I R] ) 
r26  (  [2  6  I R] ) 
r27 ( [27 | R] ) 
r28 ( [28 IR] ) 
r29< [29  I R] ) 
r30 ( [30 IR] ) 
r31 ( (31 1 R] ) 
r32 ( [32  I R] ) 
r 33 ( [ 33  I R] ) 
r34 ( [34  I R] ) 
r35 ( [35  I R] ) 
r36 ( ( 36  I R] ) 
r37  ( ( 37  I R] ) 
r38 < [38 IR] ) 
r39 ( [39 1 R] ) 
r40 ( [40  I R] ) 
r41 ( [41 |R] ) 
r42 ( [ 42  I R] ) 
r43 ( [ 43  I R] ) 
r44 ( [44 IR] ) 
r4S ( (45  |RJ) 
r46  (  [ 4  6  I R] ) 
r 47 ( [47 | R] ) 
r48 ( [48 | R] ) 
r49 ( [ 4 9  I R] ) 


-  rl9 (R) . 

-  r20 (R)  . 

-  r21 (R) . 

-  r22 (R)  . 

-  r23 (R)  . 

-  r24 (R)  . 

-  r2  5  (R)  . 

-  r26 (R) . 

-  r27 (R) . 

-  r28 (R)  . 
r29 (R)  . 

-  r30 (R) . 

-  r31 (R)  . 

-  r32 (R) . 

-  r33  (R)  . 

-  r34 (R)  . 

-  r35 (R) . 

-  r36(R)  . 

-  r37 (R) . 

-  r38 (R)  . 

-  r39 (R)  . 

-  r40 (R)  . 

-  r41  (R)  . 

-  r42 (R)  . 

-  r43 (R) . 

-  r44 (R)  . 

-  r45  (R)  . 

-  r46 (R)  . 

-  r4  i  (?.]  . 

-  r48 (R) . 

-  r49 (R) . 

-  r50 (R)  . 
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r5Q ( [50 | R] )  : - 
r51 ( [51 IR] )  :  - 
r52 ( [52  I R] ) 
r53 ( [53  I R] )  : - 
r54  ( ( 54  I R] ) 
r55 ( [55 IR] ) 
r56 ( [56 | R] ) 
r57 ( [ 57 | R] )  : - 

r58 ( [ 58  I R] ) 
r59 ( [59 IR] ) 
r 60 ( [ 60  I R] )  : - 

col ( [ 61 1 R] )  :  - 

r62 ( [ 62 | R] ) 
r 63 ( [ 63 |R] )  s- 
r 64 ( [ 64 | R] ) 
r 65 ( [ 65  I R] ) 
r66 ( [66 |RJ )  :  - 

r67 ( [67 |R] )  :  - 

r 68 ( [ 68  |  R  J )  :  - 
r 69 ( [ 69 | R] ) 
r70 ( [70 IR] ) 
r 71 ( [ 71 1 R] )  :  - 
r  72 ( [ 72 | R] ) 
r 73 ( [ 73 | R] ) 
r74 ( [74 IR] )  : 
r 75 ( [ 75  | R] ) 
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setof 


#  /* 

setof. m:  Pereira  benchmark  secof  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s) :  $ _ OPTIONS _ S 

% 

%  setof 

% 

%  Fernando  C.  N.  Pereira 
*if  BENCH 

#  include  setof . bench" 

#e  ise 

#option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (setof/3! . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.” 

#  if  DUMMY 

setof  dummy(X,  Y"pr(X,  Y)  ,  _)  . 

dummy (_,  _,  _) . 

#  else 

setof  setof  (X,  Y‘pr(X,  Y)  ,  _)  . 

#  endif 
♦endif 

♦include  "pr" 
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pair_setof .m 


♦  /* 

pair_setof .m:  Pereira  benchmark  pair_setof  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option.  ( s)  :  S _ OPTIONS _ $ 

% 

%  pair_setof 
% 

%  Fernando  C.  N.  Pereira 
#if  3ENCH 

#  include  " .pair_setof .bench" 

♦else 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (setof/3) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 


>  execution  time 

measurement 

when  BENCH  is  selected." 

#  if  DUMMY 
pair_setof  : 

:  -  dummy  (  (X,  Y) 

,  pr(X,  Y), 

S)  . 

dummy (_,  _, 

_)  . 

♦  else 
pair_setof  : 

u  _ 1:  r 

setof  (  (X,  Y) 

,  pr (X,  Y)  , 

S)  . 

#  endif 
♦endif 

♦include  "pr” 
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double  setof.m 


*  /* 

double_setof  .m:  Pereira  benchmark  double_setof  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  opt  ion ( s)  :  S _ OPTIONS _ S 

% 

%  double_setof 

% 

%  Fernando  C.  N.  Pereira 
#if  3ENCH 

#  include  " .double_setof .bencn" 

#else 

#opt ion  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (setof/3)  , 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 

#  if  DUMMY 

double_setof  dummy((X,S),  setof (Y,  pr(X,  Y)  ,  S)  ,  T)  . 

dummy  (_,  _,  _)  . 

#  else 

double_setof  setof((X,S),  setof(Y,  pr(X,  Y) ,  S)  ,  T)  . 

#  endif 
#endif 

ftinclude  ”pr" 
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bagof .m 


♦  /* 

bagof. m:  Pereira  benchmark  bagof  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s):  S _ OPTIONS _ $ 

% 

%  bagof 
% 

%  Fernando  C.  N.  Pereira 
#if  BENCH 

If  include  "  .bagof  .bench" 

♦else 

♦option  DUMMY  “ 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (bagof/3) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 

♦  if  DUMMY 

bagof  dummyfX,  Y'prfX,  Y) ,  S)  . 

dummy (_,  _,  _) . 

♦  else 

bagof  bagof (X,  Y*pr(X,  Y) ,  S)  . 

♦  endif 
♦endif 

♦include  "pr" 
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pr:  (Pereira)  pr/2  for  setof, 
*/ 

pr  (99,  1)  . 
pr  (98,  2)  . 
pr  (97,  3)  . 
pr  (96,  4)  . 
pr  (95,  5)  . 
pr  (94,  6)  . 
pr (93,  7)  . 
pr (92,  8)  . 
pr (91,  9)  . 
pr (90,  10)  . 
pr  (89,  11)  . 
pr'83,  12). 
pr  (87,  13)  . 
pr  (86,  14)  . 
pr  ( 85 ,  15 )  . 
pr  (84,  16)  . 
pr  (83,  17)  . 
pr (82,  18)  . 
pr  (81,  19)  . 
pr  (80,  20)  . 
pr  (79,  21)  . 
pr  (78,  22)  . 
pr (77,  23) . 
pr  ( 76,  24 )  . 
pr (75,  25)  . 
pr  (74,  26)  . 
pr  (73,  27)  . 
pr  (72,  28)  . 
pr  (71,  29)  . 
pr  (70,  30)  . 
pr  (69,  31)  . 
pr (68,  32) . 
pr (67,  33) . 
pr  (66,  34)  . 
pr (65,  35)  . 
pr  (  64 ,  36)  . 
pr (63,  37)  . 
pr  (  62 ,  38)  . 
pr  ( 6 1 ,  3  9). 

'(60,  40). 

.--(59,  41). 
pr (58,  42)  . 
pr  (57.  43)  . 
pr  (56,  44)  . 
pr (55,  45)  . 
pr  ( 54  ,  4  6). 
pr  (53,  47)  . 
pr (52,  48)  . 
pr  (51,  49)  . 
pr (50,  50)  . 


pair_secof,  double_setof ,  and  bagof 
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Pr 


pr  (49,  51)  . 
pr (48,  52)  . 
pr  ( 4 7,  53)  . 
pr  (46,  54)  . 
pr (45,  55)  . 
pr  (44,  56)  . 
pr (43,  57)  . 
pr (42,  58)  . 
pr  (41,  59)  . 
pr ( 40 ,  60 )  . 
pr  (39,  61)  . 
pr (38,  62'  . 
pr  (37,  63)  . 
pr  ( 3 6,  64 )  . 
pr (35,  65)  . 
pr  (34,  66)  . 
pr  (33,  67)  . 
pr  (32,  68)  . 
pr  (31,  69)  . 
pr  (30,  70)  . 
pr  (29,  71)  . 
pr  (28,  72)  . 
pr  (27,  73)  . 
pr  (26,  74)  . 
pr (25,  75)  . 
pr  (54,  76)  . 
pr  (23,  ?-’). 

pr  (22,  78'  . 
pr  (21 ,  79). 
pr (20,  50)  . 
pr  (19,  81)  . 
pr (18,  82). 
pr  (17,  83)  . 
pr (16,  84) . 
pr (15,  85)  . 
pr (14,  86)  . 
pr  (13,  37)  . 
pr (12,  88)  . 
pr  (11,  89)  . 
pr  (10,  90)  . 
or (9,  91)  . 

□  r (8,  92)  . 
pr (7,  93)  . 
pr (6,  94)  . 
pr (5,  95)  . 
pr (4,  96)  . 
pr (3,  97)  . 
pr (2,  98)  . 
pr  (1,  99)  . 
pr (0,  100)  . 
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cons  term.m 


*  /* 

cons_term.m:  Pereira  benchmark  cons_;erm  master  file 

V 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option  (s)  :  S_OPTIONS _ S 

% 

%  cons_term 

% 

%  Fernando  C.  N.  Pereira 
% 

%  Construct  a  term  with  100  nodes  nonrecursively . 

*  if  BENCH 

it  include  ".cons  term. bench" 

♦  else 

cons_term  sl(_|  . 
itendi  f 

(♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (si/i)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected, 
ttif  DUMMY 

si (_) . 

(♦halt 

itendif 

(♦include  "si" 
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walk  term . m 


*  /* 

walk_term.m:  Pereira  benchmark  waik_term  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option ( s ) :  S _ OPTIONS _ S 

% 

%  walk_term 
% 

%  Fernando  C.  N.  Pereira 
% 

%  Walk  down  a  term  with  100  nodes  nonrecursively. 

*if  BENCH 

♦  include  " .walk_term. bench" 

#else 

walk_term  si(T), 
wt (T)  . 

#endif 

♦include  "si" 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (wt/1)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
♦if  DUMMY 

wt (_)  . 

♦halt 

♦endif 

wt (f  (1,  R)  )  s2 (R)  . 
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walk  term  rec.m 


♦  /* 

walk_term_rec .m:  Pereira  benchmark  walk_term_rec  raster  file 
*/ 

%  generated:  _ MDAY  _ MONTH _  _ YEAR _ 

%  option (s):  S _ OPTIONS _ S 

% 

%  walk_term_rec 
% 

%  Fernando  C.  N.  Pereira 
% 

%  Walk  down  a  term  with  100  nodes  recursively. 


♦  if  BENCH 

♦  include  walk_term_rec. bench" 
#else 

walk_te.rm_rec  si(L), 
wtr(L). 


♦endif 


♦include  "si 


♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (wtr/1)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
♦if  DUMMY 

wtr  (_)  . 

♦  halt 
♦endif 

%  recursive  term  cruncher 


wtr  (nil )  . 

wtr  ( f  (_,  R)  )  wtr(R)  . 
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si 


#  /* 

si:  (Pereira)  nonrecursive  term  cruncher 
*/ 

%  nonrecursive  term  cruncher 


sl(f  (1,  R>  )  : 
s2(f  <2,  R)  )  : 
s3 (f  (3,  R) )  : 
s4 (f (4,  R))  : 
s5 (f  (5,  R)  )  : 
s6  (f  (6,  R) )  : 
s7 (f (7,  R)  )  : 

s8 (f (8,  R)  )  : 
s9 (f  (9,  R)  )  : 
slO (f (10,  R)  ) 
slKftll,  R)  ) 
sl2 ( f (12 ,  R)  ) 
sl3 (f  (13,  R)  ) 
sl4 (f  (14,  R)) 
sl5 (f  (15,  R)) 
sl6 (f  (16,  R) ) 
sl7 ( f ( 17 ,  R) ) 
sl8  ( f  (18,  R)  ) 
sl9 (f  (19,  R) ) 
s20 (£  (20,  R)  ) 
s21  (f  (21,  R)  ) 
s22 (f (22,  R)) 
s23(f(23,  R)) 
s24 (f  (24,  R)) 
s25(f(25,  R)> 
s26  (f  (26,  R)  ) 
s27(f<27,  R)) 
s28 (f  (28,  R)  ) 
s29  (f  (29,  R)) 
s30 (f  (30,  R)  ) 
s31 (f  (31,  R)  ) 
s32(f(32,  R)  ) 
s33 (f  (33,  R)  ) 
s34 ( f  (34 ,  R)  ) 
s35 (f  (35,  R)  ) 
s36  ( f  (36,  R)  ) 
337  <f (37,  R) ) 
s38  ( f  (38 ,  R)  ) 
s39  (f  (39,  R)  ) 
s40  (f  (40,  R)  ) 
S41 (f  (41,  R) ) 
s42 (f (42,  R) ) 
s43 (f (43,  R) ) 
s44 (f (44,  R)) 
s45 ( f  (45,  R)  ) 
s46  ( f  (4  6,  R)) 
s47 (f  (47,  R) ) 
s48  ( f  (48,  R)  ) 
s49  (f  (49,  R)) 
s50 ( f (50,  R) ) 


s2 (R)  . 
s3 (R)  . 
s4 (R)  . 
s5 (R)  . 
s6(R)  . 
s7 (R)  . 
s8 (R)  . 
s9(R)  . 
slO (R)  . 

-  sll (R)  . 

-  sl2 (R)  . 

-  sl3 (R)  . 

-  sl4 (R)  . 

-  sl5 (R)  . 

-  sl6 (R)  . 

-  sl7 (R)  . 

-  sl8 (R) . 

-  sl9  (R)  . 

-  s20 (R)  . 

-  s21 (R)  . 

-  s22 (R)  . 

-  s23 (R) . 

-  s24 (R) . 

-  s25 (R)  . 

-  s26(a). 

-  s27 (R)  . 

-  s28 (R) . 

-  s29 (R)  . 

-  s30 (R)  . 

-  s31 (R)  . 

-  s32 (R)  . 

-  s33 (R)  . 

-  s34 (R)  . 

-  s35 (R) . 

-  s36 (R)  . 

-  s37(R)  . 

-  s38 (R)  . 

-  s39 (R)  . 

-  s40 (R)  . 

-  s41 (R)  . 

-  s42 (R)  . 

-  s43 (R)  . 

-  s4 4 (R)  . 

-  s45 (R)  . 

-  s4 6 (R)  . 

-  s47 (R)  . 

-  s48 (R)  . 

-  s49 (R)  . 

-  s50 (R)  . 

-  s51 (R) . 


pereira  *52 


si 


s51 (f  (51,  R)  ) 
s52(f(52,  R)) 
s53  ( f  (53,  R)  ) 
s54 (f  (54,  R) ) 
s55 (f (55,  R) ) 
s56  (f  (56,  R)) 
s57 (f (57,  R) ) 
s58 (f (58,  R)  ) 
s59  (f  (59,  R)  ) 
s60 (f  (60,  R)  ) 
s61 (f (61,  R)  ) 
s62 (C  (62,  R)  ) 
s63 (f  (63,  R)) 
364  (5(69,  R)  ) 
s65 (f (65,  R) ) 
s66 (f (66,  R) ) 
s67 ( f (67,  R)) 
s68  (f  (68,  R) ) 
s69 (f (69,  R) ) 
s70 (f (70,  R) ) 
s71  (f  (71,  R)  ) 
s72 (f  (72,  R)  ) 
s73 (f (73,  R)) 
s74  ( f  (74 ,  R)  ) 
s75  ( f  (75 ,  R)  ) 
s76  (f  (76,  R)  ) 
s77 (f  (77,  R) ) 
s78 (f (78,  R) ) 
s79  ( f  (79,  R)  ) 
s80  ( f  (80,  R)) 
s81 (f (81,  R)) 
s82 ( f  (82,  R)  ) 
s83 (f  (83,  R)  ) 
s84 (f (84,  R)  ) 
s85 (f (85,  R) ) 
s86  ( f  (86,  R)  ) 
s87 (f (87,  R)) 
s88 (f (88,  R) ) 
s89  (f  (89,  R)  ) 
s90 ( f  (90 ,  R)  ) 
s91 ( f (91 ,  R) ) 
s92  <  f ( 92,  R)) 
s93 (f (93,  R)  ) 
s94 (f (94,  R)  ) 
s95 ( f  (95,  R)) 
s96 (f  (96,  R) ) 
s97 ( f  (97,  R) ) 
s98 (f (98,  R)  ) 
s99 (f (99,  R) ) 
slOO (f  (100,  R)  ) 
slOl  (nil)  . 


-  s52 (R)  . 

-  s53 (R) . 

-  s54 (R) . 

-  s55 (R) . 

-  s56 (R) . 

-  s57 (R) . 

-  s58 (R) . 

-  s59  (R)  . 

-  s60  (R)  . 

-  s61 (R) . 

-  s62 (R)  . 

-  s63 (R) . 

-  s64 (R)  . 

-  s65 (R)  . 

-  s66  (R)  . 

-  s67 (R)  . 

-  s68 (R)  . 

-  s69 (R)  . 

-  s70 (R)  . 

-  s71 (R)  . 

-  s72 (R)  . 

-  s73 (R)  . 

-  s74 (R)  . 

-  s75 (R)  . 

-  s76 (R)  . 

-  s77 (R)  . 

-  s78 (R)  . 

-  s79  (R)  . 

-  s80 (R)  . 

-  s81  (R)  . 

-  s82 (R)  . 

-  s83 (R)  . 

-  s84 (R)  . 

-  s85 (R)  . 

-  s86  (R)  . 

-  s87 (R)  . 

-  s88  (R)  . 

-  s89 (R)  . 

-  s9Q (R) . 

-  s91 (R)  . 

-  s92 (R)  . 

-  s93  (R)  . 

-  s94  (R)  . 

-  s95 (R)  . 

-  s96  (R)  . 

-  s97 (R) . 

-  s98 (R)  . 

-  s99  (R)  . 
slOO (R) . 

slOl (R)  . 
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medium  unify. m 


#  /* 

medium_uni f y .m:  Pereira  benchmark  nedi'JT._ur.ify  master  file 

*7 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s):  S _ OPTIONS _ S 

% 

%  medium_unify 
% 

%  Fernando  C.  N.  Pereira 
% 

%  Unify  structures  5  deep. 

#if  BENCH 

#  '■"'dude  "  ,medium_unify  .bench” 

#else 

nediumjunify  term64 (Terml) , 
cerm64 (Term2 )  , 
equal (Terml,  Term2) . 

♦endif 

term64 (XI)  : - 

XI  «  f (X2,  X2) , 

X2  =  f(X4,  X4 ) , 

X4  =  f (X8 ,  X8) , 

X8  =  f (X16,  X16)  , 

X16  =  f (X32,  X32) , 

X32  =  f (X64,  X64)  . 

((option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (equal/2) . 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
#if  DUMMY 

equal (_,  _) . 

#else 

equal (X,  X) . 

#endif 
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deep_unif y .  m 


*  /* 

aeep_unify .m:  Pereira  benchmark  deep_unify  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ _YEAR _ 

%  option (s):  $ _ OPTIONS _ S 

% 

%  deep_unify 
% 

%  Fernando  C.  N.  Pereira 

% 

%  Unify  structures  11  deep. 

*if  BENCH 

#  include  " .deep_unify . bench" 

#else 

deep_unify  term4096 (Terml) , 
term4096  (Term2)  , 
equal (Terml,  Term2) . 

#endif 


term4096(Xl) 

XI  =  f (X2,  X2 ) , 

X2  =  f (X4,  X4 ) , 

X4  =  f(X8,  X8 ) , 

X8  =  f (X16,  X16) , 

XI 6  =  f (X32,  X32) , 

X32  =  f (X64,  X64 ) , 

X64  =  f (X128,  X128 ) , 

X128  =  f (X256,  X256) , 

X25 6  =  f (X512,  X512) , 
X512  =  f (X1024,  X1024) , 
X1024  =  f (X2048,  X2048) , 
X2048  -  f  (X4096,  X4096) . 


♦option  DUMMY  ” 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (equal/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  tun  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
#if  DUMMY 


equal  (_,  _)  . 
♦  else 

equal  (X,  X)  . 
tendif 


pereira  *55 


.  f -oat ing_add . bench 


♦  /* 

set-up . float ing_add:  bench  set-up  for  floating_aad 

*  / 

floating_add  :-  dr iver ( float ing_ada) . 

benchmark ( f loat ing_add,  fal(0.1,  1.1,  R) ,  dummy (0.1,  1.1,  R 
♦message  "NOTE:  show/1  is  NOT  defined  for  f loating_add" 

♦include  "driver" 


) ,  1000) . 
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.  integer_add . bench 


♦  /* 

set-up . integer_add:  bench  set-up  for  integer^add 

*/ 

integer_add  :-  driver ( integer_add) . 

benchmark ( integer_add,  al(0,  1,  R) ,  dummy (0,  1,  R) , 

♦message  "NOTE:  show/1  is  NOT  defined  for  integer 


♦include  "driver" 


1000)  . 
idd" 
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arg_l .bench 


#  /* 

set-up . arg_i :  bench  set-up  for  (arg)  arg_l 
'/ 

arg_l  driver (arg_l) . 

benchmark  (arg_l,  arglll,  Term,  _)  ,  dummyd,  Term,  _)  ,  2000)  :- 
complex_nary_term (100,  1,  Term). 

♦message  "NOTE:  show/1  is  NOT  defined  for  arg_l" 


♦  include  '‘ar;ver" 
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. arg  2. bench 


*  /* 

set-up . a rg_2 :  bench  set-up  for  (arg)  arg_2 

*/ 

arg_2  :-  driver (arg_2) . 

benchmark (arg_2,  argl(2.  Term,  ,  dummy<2.  Term,  _) ,  2000)  :- 
complex_nary_term (100,  2,  Term) . 

# message  "NOTE:  show/1  is  NOT  defined  for  arg_2" 


((include  "driver” 
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arg_4 .bench 


*  /* 

set -up . arg_4 :  bench  set-up  for  (arg)  arg_4 

*  f 

arg_4  driver (arg_4) . 

benchmark (a rg_4,  argi(4,  Term,  _J  ,  dummy (4,  Term, 
compiex_nary_term { 100,  4,  Term). 

^message  "NOTE:  show/1  is  NOT  defined  for  arg_4” 


# i nc 1 ude  " dr i ve r “ 


),  2000) 
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arg  8 . bench 


♦  /* 

set-UD.arg_8 :  bench  set-up  for  (arg)  arg_8 
*/ 

arg_8  driver (arg_8) . 

benchmark.  (arg_8,  argi{8,  lerm,  _)  ,  dummy  (8,  Term, 
complex_nary_term (100,  8,  Term). 

♦message  "NOTE:  show/1  is  NOT  defined  for  arg_8" 
♦include  "driver" 


),  2000) 
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arg  16. bench 


#  /* 

set-up. arg_16:  bench  set-up  for  (arg)  arg_16 

*/ 

arg_I6  :-  driver  (arg_16)  . 

benchmark  (arg_16,  argl(16.  Term,  _)  ,  dummy  (16,  Term,  _)  ,  2000) 
complex_nary_term (100,  16,  Term). 

♦message  "NOTE:  show/1  is  NOT  defined  for  arg_16" 


♦include  "driver" 


« 


« 
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assert  unit. bench 


sec-up , assert_unit :  bench  sec-up  for  assert_unic 
V 

asserc_unit  :-  driver (asserc_unic) . 

benchmark (assert_unit,  asserc_ciauses (L) ,  dummy (L),  5) 
abolish  (ua,  3)  , 
creace_units (1,  1000,  L)  . 

message  "NOTE:  show/1  is  NOT  defined  for  asserC_unit “ 


♦include  "driver" 
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.access  unit. bench 


set-up . access_unit :  bench  set-up  for  access_unit 

*/ 

accessjjnit  :-  driver (access_unit)  . 

benchmark (access_unit,  access_dix (1,  1),  dummy !1,  1),  ICO) 
abolish (dix,  2) , 
aix_clauses (1,  100,  L)  , 
assert_clauses (L) . 

♦message  "NOTE:  show/1  is  NOT  defined  for  access_unit" 


♦include  "driver" 
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.slow  access  unit. bench 


*  /* 

set-up . slow_access_unit :  bench  set-up  for  3low_access_unit 

*/ 

slow_access_unit  dr i ver ( s low_access_unit ) , 

benchmark (slow_access_unit,  access_back (1,  1),  dummy (1,  1),  10 

abolish (dix,  2) , 
dix_clauses (1,  100,  L)  , 
assert_clauses (L) . 

(♦message  "NOTE:  show/1  is  NOT  defined  for  s low_access_un it " 
♦include  "driver" 
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shallow_backtracking .bench 


#  /* 

set-up .  shallow_backtracking :  bench  set-up  for  shal  iow_bacict  racking 
*/ 

shallow_backtracking  driver (shailow_backtracking) . 
benchmark (shallow_backtracking,  shallow,  dummy,  2000). 

#message  "NOTE:  show/1  is  NOT  defined  tor  snaiiow_DacKtj.acking" 


ftinclude  "driver" 


pereira  *66 


.  deep__backt racking  .bench 


♦  /* 

set-up  .deep_backtracking:  bench  set-up  for  deep_backtracking 

*/ 

deep_backtracking  :-  driver (deep_backt racking) . 
benchmark (deep_backtracking,  deep,  dummy,  2000). 

♦message  "NOTE:  show/1  is  NOT  defined  for  deep_backtracking" 


♦include  "driver" 
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.tail  call  atom  atom. bench 


*  /* 

set-up . tail_call_atom_atom:  bench  set-up  for  tail_call_atom_atom 

V 

tail_cal l_atom_atom  driver (tail_call_atom_atom) . 

benchmark.  (tail_call_atom_atom,  pi  (a)  ,  dummy(a),  2000). 

♦message  "NOTE:  show/1  is  NOT  defined  for  tail_call_atom_atom" 

♦include  "driver" 
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.  binary_call_at om_atom . bench 


#  /* 

set-up .binary_call_atom_atom:  bench  set-up  for  binary_call_atom_atom 
*/ 

binary_call_atom_atom  :-  driver (binary_call_atom_atom) . 
benchmark (binary_call_atom_atom,  ql (a) ,  dummy(a),  2000). 

♦♦message  "NOTE:  show/1  is  NOT  defined  for  binary_cal l_atom_atom" 


(♦include  "driver" 
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.  choice_jpoint  .bench 


#  /* 

set-up  . choice_point :  bench  set-up  for  choice_po:r.t 

*/ 

choice_point  :-  driver (choice_paint) . 
benchmark (choice_point,  choice,  dummy,  2000). 

((message  "NOTE:  show/1  is  NOT  defined  for  choice_point" 


#include  "driver" 
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.brail  variables .bench 


set -up . t r ai l_var iables :  bench  set-up  for  ttail_variables 

*/ 

trail_variabl.es  driver  (trail_variables)  . 
benchmark <trail_variables,  trail,  dummy,  2000). 

# message  "NOTE:  show/1  is  NOT  defined  for  trail_variables" 

^include  "driver" 
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.  index .bench 


*  /* 

sec-up. index:  bench  set-up  for  index 

*/ 

index  :-  driver  (index)  . 

benchmark.  ( index,  ix(l),  dummy  (1),  2000). 

♦message  "NOTE:  show/1  is  NOT  defined  for  index" 

♦include  "driver" 
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.cons  list. bench 


#  /* 

set-up . cons_l ist :  bench  set-up  for  cons_iisc 
*/ 

cons_list  :-  driver (cons_list) . 

benchmark (ccns_list,  rl (_) ,  dummy (_) ,  2C00)  . 

(♦message  "NOTE:  show/1  is  NOT  defined  for  cons_iist 


(♦include  "driver” 
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.walk  list. bench 


♦  /  w 

ser-up.waik_iist  :  bench  set-up  for  va Ikiist 

*/ 

walk_iist  driver (waik_2ist ) . 

benchmark (walk_list,  wl(L),  dummy (L),  2000)  rl (L) . 
♦message  "NOTE:  show/1  is  NOT  defined  for  walk_list" 

♦include  "driver" 
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.walk  list  rec. bench 


♦  /* 

set-up . walk_list_rec :  bench  set-up  for  wa lk_i ist_rec 
*/ 

walk_list_rec  :-  dr iver (walk_list_rec) . 

benchmark ( walk_l ist_rec,  wir(L),  dummy (L) ,  2000)  rl (L) . 
♦message  "NOTE:  show/1  is  NOT  defined  for  wa lk_i ist_rec" 


♦include  "driver" 
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args_2 .bench 


*  /* 

set-up . args_2 :  bench  set-'  n  for  (args)  args_2 

*/ 

args_2  dr i ver (a rgs_2 ) . 

benchmark (args_2,  args (2,  L) ,  dummy (2,  L! ,  2000)  rl(L). 
♦message  "NOTE:  show/1  is  NOT  defined  for  args  2“ 


♦include  "driver" 
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args  4. bench 


*  /* 

set-up . args_4 :  bench  set-up  for  (args)  args_4 
*/ 

args_4  :-  driver (args_4 ) . 

benchmark (args_4,  args (4,  L) ,  dummy (4,  L)  ,  2000)  :-  rl(L). 
♦message  "NOTE:  show/1  is  NOT  defined  for  args_4" 


♦include  "driver" 
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.args  8. bench 


*  /* 

sec-up . args_8 :  bench  sec-up  for  (args)  args_8 
*/ 

args_8  :-  dr iver (args_8 ) . 

benchmark  (args_8,  args(8,  L)  ,  dummy(8,  L)  ,  2000)  :-  rl(L). 

((message  "NOTE:  show/1  is  NOT  defined  for  args_8" 


((include  "driver" 
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.  args_16 .bench 


#  /* 

set-up . args_l 6 :  bench  set-up  for  (args)  args_16 
V 

args_16  :-  driver (args_16) . 

benchmark (args_16,  args (16,  L) ,  dummy (16,  L) ,  2000)  : 
♦message  "NOTE:  show/1  is  NOT  defined  for  args_16" 


♦include  "driver" 


rl  (L) 
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.  setof .bench 


♦  /* 

set-up . setof :  bench  set-up  for  setof 
V 

setof  :-  driver (setof ) . 

♦  if  DUMMY 


benchmark (setof, 

dummy (X, 

Y~pr (X,  Y), 

S)  ,  dummy  (X,  Y‘pr(X,  Y)  , 

S)  , 

10) 

♦else 

benchmark (setof. 

setof (X, 

Y'pr (X,  Y), 

S),  dummy  (X,  Y'pr(X,  Y)  , 

S)  , 

10) 

#endif 

♦message  "NOTE:  show/1  is  NOT  defined  for  setof" 

♦include  "driver" 
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.pair_set of .bench 


♦  /* 

set-up . pair_setof :  bench  set-up  for  pair_setof 
*/ 

pair_setof  driver  (pair_setof)  . 

#if  DUMMY 


benchmark (pair  setof. 

dummy ( (X, Y) , 

pr  (X,  Y), 

S), 

♦  else 

dummy  (  (X,  Y)  , 

pr (X,  Y>, 

S) , 

10)  . 

benchmark (pair  setof. 

setof ( (X, Y) , 

pr  (X,  Y), 

S) , 

♦endif 

dummy  (  (X,  Y)  , 

pr  (X,  Y)  , 

S) , 

10)  . 

♦message  "NOTE:  show/1  is  NOT  defined  for  pair_setof" 

♦include  "driver" 
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double  setof .bench 


♦  /* 

set-up .double_setof :  bench  set-up  for  double_setof 

*/ 

double_setof  :-  driver (double_setof ) . 

#if  DUMMY 


benchmark (double_setof , 

dummy (  (X,  S)  , 

setof (Y,  pr (X,  Y) , 

S)  , 

T) 

♦else 

dummy ( (X, S) , 

setof  ( Y,  pr  (X,  Y)  , 

S)  , 

T) 

benchmark (double_setof , 

setof ( (X, S) , 

setof(Y,  pr  (X,  Y)  , 

S)  , 

T) 

♦endif 

dummy  (  (X,  S)  , 

setof  (Y,  pr  (X,  Y)  , 

S)  , 

T) 

♦message  "NOTE:  show/1  is  NOT  defined  for  double_setof ” 


♦include  "driver" 
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bagof .bench 


♦  /’ 

set-up  .  bagof  :  bench  set-up  for  bagof 
V 

bagof  driver (bagof )  . 

#if  DUMMY 

benchmark (bagof ,  dummy (X,  Y~pr(X,  Y) ,  S) ,  dummy (X,  Y  pr(X, 
#else 

benchmark (bagof,  bagof (X,  Y*pr(X,  Y) ,  S) ,  dummy (X,  Y‘pr(X, 
#endif 

♦message  "NOTE:  show/1  is  NOT  defined  for  bagof" 


♦include  "driver" 
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cons  term. bench 


♦  /* 

set-up . cons_term:  bench  set-up  for  cons_tern 

*/ 

cons_term  :-  driver (cons_term) . 

benchmark (cons_term,  si ( _ ) ,  dummy (_) ,  2000). 

♦message  "NOTE:  show/1  is  NOT  defined  for  cons_term" 


♦include  "driver" 
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walk  term. bench 


♦  /* 

set-up. walk_term:  bench  set-up  for  walk_term 
*/ 

walk_term  :-  driver (walk_term) . 

benchmark (walk_term,  wt  (T) ,  dummy (T),  2000)  :-  sl(T). 

♦message  "NOTE:  show/1  is  NOT  defined  for  walk  term" 


♦include  "driver" 
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.walk  term  rec. bench 


*  /* 

se t-up .  wa lk_cerm_rec  :  bench  sec-up  for  walk_rerm_rec 

*/ 

walk_term_rec  driver (walk_cerm_rec) . 

benchmark (walk_term_rec,  wtr(T),  dummy(T),  2000)  sl(T). 
♦message  "NOTE:  show/1  is  NOT  defined  for  wa lk_term_rec" 


♦include  "driver" 
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.medium_unify .bench 


*  /* 

sec-up .medium^unif y :  bench  sec-up  for  medium_unify 
*/ 

medium_unify  driver (medium_unify) . 

benchmark (medium_unify,  equal (Terml,  Term2) ,  dummy (Terml,  Term2),  2000) 
Cerm64 (Terml) , 
term64 (Term2) . 

imessage  "NOTE:  show/1  is  NOT  defined  for  medium_unify" 


#include  "driver" 
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.deep  unify. bench 


#  /* 

set -up . deep_uni f y :  bench  set-up  for  deep_unify 

*/ 

deep_unify  :-  driver (deep_uni fy) . 

benchmark (deep_uni fy,  equal (Terml.  Term2) ,  dummy (Terml,  Term2), 
term4096  (Terml)  , 
term4096  (Term2)  . 

imessaqe  "NOTE:  show/1  is  NOT  defined  for  deep_unify" 


♦include  "driver" 
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plm  compiler 


plm_compiler  .m .  1 

plm_compiler .  2 

test  .  38 

.  plm_compiler  .bench .  39 


plm_compiler  .m 


♦  /* 

plm_compiler . m:  benchmark  plm_compiler  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s):  $ _ OPTIONS _ $ 

% 

%  plm_compiler 
% 

%  compile  small  Prolog  file  to  PLM  code 

♦option  /*  BIM  PL  C_PL  QUINTUS_PL  3B_PL  SICSTUS_PL 

are  *option'd  in  . plm_compi ler . bench  */  " 

>  Tf  a  PLM  compiler  includes  system-dependent  code. 

>  If  one  of 

> 

>  BIM_PL  C_PL  QUINTUS_PL  SB_PL  SICSTUS_PL 

> 

>  is  selected,  then  appropriate  code  is  generated." 

# if  BENCH 

#  include  n .plm_compiler -bench" 

#  else 

#  if  BIM_PROLOG 

plm_compiler  bim, 

#  el seif  C_PROLOG 

plm_compiler  c, 

#  el seif  QUINTUS_PROLOG 
no_style_check(single_var) . 

plm_compiler  quintus, 

#  el seif  SB_PROLOG 

plm_compiler  sb, 

#  else1 f  SICTUS_PROLOG 

plm_compiler  sicstus, 

#  else 
plm_compiler 

#  endif 

options (test,  []), 

see  (test),  read_clauses (Cl) ,  seen, 
cap  (Cl)  . 

♦endif 

♦option  DUMMY  ” 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (cap/1) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
♦if  DUMMY 

cap (_) . 

♦else 

cap(CI)  tell  (' test  .w' )  ,  compileallprocs  (Cl)  ,  told. 

♦endif 


♦include  "plm_compiler"  /*  compiler  for  the  PLM  */ 
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plm_compiler 


#  /* 

plra_compiler :  compiler  for  the  PLM 
*/ 

%  Here  is  the  latest  version  of  the  PLM  compiler  as  described 
%  in  my  Master's  report  (UCB/CSD  84/203),  slightly  modified 
%  for  benchmarking.  I  ask  that  you  reference  the  report  in 
%  any  published  work  which  uses  it.  This  version  has  been 
%  modified  to  run  under  five  Prolog  systems  -  B1M  Prolog, 

%  C-Prolog,  Quintus  Prolog,  SB  Prolog,  and  SICStus  Prolog. 

%  The  call  pirn (FileName)  will  compile  FileName.  Note  that 
%  one  of  the  five  calls  bim,  c,  quintus,  sb,  or  sicstus  must 
%  be  done  first  for  correct  execution  under  your  system. 

%  WAM  code  will  be  put  on  FileName. w. 

% 

%  Compiler  options: 

% 

%  plm(f ilename,  optionlist) 

% 

%  where  the  options  are: 

%  a  use  no-argument  allocate  with  dummy  call. 

%  (default:  use  allocate  with  environment  size  argument) 

%  1  output  in  Prolog-readable  list  form. 

%  (default:  output  in  human-readable  form) 

%  u  do  not  expand  is/2  into  is/4. 

%  (default:  expand  is/2  into  is/4) 

%  s  compile  into  +,-, \/,/\  instead  of  is/4.  Other  operators 

%  are  still  compiled  into  is/4. 

%  (default:  use  is/4  for  all  operators)' 

%  q  quote  all  atoms.  Only  has  effect  if  option  1  is  not  used. 

%  (default:  quote  only  those  atoms  that  need  it) 

%  a(X)  append  _X  to  all  labels  in  the  human-readable  code. 

%  (default:  append  nothing  to  labels) 

% 

%  A  single  option  does  not  have  to  be  put  in  a  list. 

% 

%  plm(f ilename)  is  the  same  as  plm(filename, [] ) . 

% 

%  plm_help  gives  on-line  help  with  the  options. 

% 

%  If  you  have  ideas  for  improvements  or  if  you 
%  find  any  bugs,  I  will  be  happy  to  hear  it. 

% 

%  Peter  Van  Roy  (vanroy@bellatrix.Berkeley.EDU) 

/********»***»*«*******.***««******,***.*»*,**********,,***».**,****,«*/ 

/*  Copyright  (C)  1987  by  Peter  Van  Roy  */ 

/*  on  behalf  of  the  Regents  of  the  University  of  California.  */ 

/*********»**«******************************„***„**  ****<•********„******/ 

%  Call  to  change  Prolog  version  at  run  time: 

bim  :-  abolish (prolog_version, 1) ,  assert (prolog_version (bimprolog) ) . 
c  :-  abolish (prolog_version, 1) ,  assert (prolog_version (cprolog) ) . 

quintus  :-  abolish (prolog_version, 1) ,  assert (prolog_version (quintusprolog) ) 
sb  :-  abolish (prolog_version, 1) ,  assert (prolog_version (sbprolog) ) . 

sicstus  :-  abolish (prolog_version, 1) ,  assert (prolog_version (sicstusprolog) ) 

/******************»*..******.*,■,»<,,*,*,„,****,  **•*„*****«*.**«****„*,/ 
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plm_compiler 


%  CPU  time  handling: 

get_cpu_time  (T)  prolog_version (bimprolog) ,  , 

cput ime (T) . 

get_cpu_time (T)  prolog_version (cprolog) ,  !, 

T  is  cput ime. 

get_cpu_t ime ( T )  prolog_version (quintusprolog)  ,  !, 

statistics (runtime,  [T,  _] )  . 
get_cpu_time (T)  prolog_version (sbprolog) ,  !, 

cput ime (T) . 

get_cpu_t ime (T)  prolog_version (sicstusprolog) ,  !, 

statistics ( runtime ,  [T,  _) ) . 

cpu_time_unit (seconds)  :- 

prolog_version (bimprolog) ,  !. 

cpu_time_unit (seconds) 

prolog_version (cprolog) ,  !. 

cpu_time_unit  ( '  mi  Hi- seconds'  )  :- 

prolog_version (quintusprolog) ,  !. 
cpu_time_unit (' milli-seconds' ) 

prolog_version (sbprolog) ,  !. 

cpu_time_unit  ('milli-seconds' ) 

prolog_version (sicstusprolog) ,  ! . 

/a*********************************************************************/ 

%  Compile  'FileName'  and  put  results  in  ' FileName .w' : 

%  Default:  no  special  options, 
pirn (FileName)  !,  pirn (FileName,  (]). 

plm (FileName,  One)  :- 
atomic (One) , 

(prolog_version (sbprolog)  ->  not(One=f]);  \+(One=(])),  !, 

plm (FileName,  [One]). 
plm(FileName,  One)  :- 

(prolog_version (sbprolog)  ->  not (list (One) ) ;  \+(list (One) ) ) , 
(prolog_version (sbprolog)  ->  not(One=[]);  \+(One=[])),  !, 
plm(FileName,  [One]). 
plm(FileName,  OptionList)  :- 
%  Handle  options: 
options (FileName,  OptionList), 

%  Read  input  file: 

see (FileName) ,  read_clauses (Cl) ,  seen, 

write ('Finished  reading  '),  write (FileName) ,  nl, 

name  (FileName,  NL) , 

name  ( '  .  w' ,  DOTH)  , 

concat (NL,  DOTW,  OF) , 

name (OutFile,  OF), 

%  Compile  &  write  output  file: 

%  get_cpu_time/2  is  defined  in  .bench/driver 
(  clause (get_cpu_time (TO,  Unit),  BodyO) ,  !,  call(BodyO) 

;  get_cpu_time (TO)  ), 
tell (OutFile) , 
compileallprocs (Cl) , 
told, 

(  clause (get_cpu_time (Tl,  Unit),  Bodyl) ,  !,  call(Bodyl) 

;  get_cpu_time (Tl)  ), 

Time  is  T1-T0, 

%  =/4  is  defined  in  .bench/driver 
(  clause (» (Time,  Unit,  Time_out,  Unit_out),  Body),  !,  call (Body), 
write ('compilation  took  '), 
write (Time_out) ,  write!'  '), 
write (Unit_out) ,  nl 
;  cpu_time_unit (Unit)  , 

write (' compilation  took  '), 
write (Time),  write ('  '), 
write  (Unit ) ,  nl  ) , 
fail . 

%  Clean  up  all  heap  space  used, 
plm (_,  _) . 
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%  Add  options  to  data  base: 
options (FileName,  OptionList)  :- 

abolish (compile_options,  1), 
assert (compile_options  (none) ) , 

atom(FileName) , full_list (OptionList) ,  add_options (OptionList) ,  ! . 

options (FileName,  OptionList)  :- 

write ('First  param  is  name  of  source  file  (atom)'), 
nl, 

write (' Second  param  is  one  option  or  a  list  of  options  (ground  terms)'), 
nl, 

abort,  ! . 

add_options ( [Opt lOptionList] )  :- 

nonvar (Opt) ,  ! , 

assert (compile_options (Opt) ) , 
add_options (OptionList) . 
add_options ( [ ] )  . 

read_clauses (Clauselnfo) 

prolog_version (X) , 

my_member(X,  (quintusprolog, cprolog, sbprolog, sicstusprolog] ) ,  !, 

c_read_clauses (Clauselnfo) ,  !. 

read_clauses (Clauselnfo) 

pro log_ver sion (bimprolog) , 
b_read_clauses (Clauselnfo) ,  !. 

c_read_clauses (Clauselnfo)  !, 
read (Clause) , 

(Clause=end_of_f ile  ->  ClauseInfo= [ ) ; 
getname (Clause,  NameAr) , 

C lause In fo= [source (NameAr .Clause)  I  Rest ] , 
c_read_clauses (Rest) ) ,  !. 

b_read_clauses (Clauselnfo)  :- 
read  (Clause)  , 
getname (Clause,  NameAr) , 

Clause In fo= [source (NameAr, Clause) l Rest ] , 
b_read_clauses (Rest) ,  ! . 
b_read_clauses ( [] ) . 


getname (Clause,  Name/Arity)  !, 

(Clause* (Head:-Body) ;  Clause=Head) , 

Head*. . [NamelArgs], 
my_length (Args,  Arity) . 

%  Generate  and  write  code  for  all  procedures  in  Clauselnfo: 
compileallprocs ( ( ] ) 

alloc_option, 
list_option,  ! . 
compileallprocs (Clauselnfo) 

filteroneproc (Clauselnfo,  NextCI,  NameAr,  OneProc)  , 
gc (compileproc (NameAr,  OneProc,  Code-!])), 
write_plm (NameAr,  Code), 
compileallprocs (NextCI) ,  !. 

%  Take  care  of  old-new  allocate  option: 
alloc_option  :- 

compile_options (a) , 

write_plm(allocate_dummy/0,  [proceed]),  !. 
alloc_option. 

%  Procedure's  end: 

list_option  :-  compile_options (1) ,  !. 

list_option  :-  write (end),  nl,  nl,  !. 


plm_compiler  *4 


plm_compiler 


f ilteroneproc ( [ ] ,  (],  _,  [])  !. 

f ilteroneproc ([ source (NameAr, C) IRest ] ,  NextCI,  NameAr,  [ClOneProc]) 
f ilteroneproc (Rest,  NextCI,  NameAr,  OneProc)  ,  !. 

f ilteroneproc (( source (N, C)  IRest ] ,  [source (N,  C)  INextCI] ,  NameAr,  OneProc) 
f ilteroneproc (Rest,  NextCI,  NameAr,  OneProc),  !. 

/*****************«*****************  ******************************  ******/ 


%  Compile  one  procedure. 

%  Input  is  a  list  of  clauses  in  unaltered  form. 

%  Output  is  complete  code  for  the  procedure. 

%  The  labels  remain  uninstantiated. 

%  The  special  compilation  for  lists,  constants,  structures 
%  is  not  needed  if: 

%  1.  Arity=0,  no  first  arguments. 

%  2.  procedure  consists  of  just  one  clause, 

%  3.  all  first  arguments  are  variables. 

%  Also  recognized  are  the  cases  where  all  first  arguments  are  either 
%  variables  or  one  other  kind. 

compileproc (_/Arity,  Clauses,  Code-Link) 
compileclauses (Clauses,  CompC) , 
var_block (CompC,  VarLbl,  VCode-VLink) , 
cp(Arity,  CompC,  VarLbl,  VCode,  VLink,  Code,  Link),  !. 

%  Easy  optimizations 

cp(Arity,  _,  _,  VCode,  VLink,  VCode,  VLink)  Arity=0,  !. 

cp(_,  CompC,  _,  VCode,  VLink,  VCode,  VLink)  my_length (CompC, 1) ,  !. 

cp (_,  CompC,  _,  VCode,  VLink,  VCode,  VLink)  all_var  (CompC) ,  !. 

%  Only  variables  and  one  other  kind  present: 
cp(_,  CompC,  VarLbl,  VCode,  VLink,  Code,  Link)  :- 
same_or_var (CompC,  Kind),  !, 
filterv (CompC,  VarC) , 
try_block (VarC,  TryLbl,  VLink-TLink) , 

cp_sub(Kind,  CompC,  TryLbl,  VarLbl,  TLink,  Link,  CLS) , 

Switch=. . [switch_an_termlCLS] , 

Code= [Switch  I VCode] . 

%  General  case:  code  for  list,  constant,  and  structure 
cp (_,  CompC,  _,  VCode,  VLink,  Code,  Link)  :- 

filterlcs (CompC,  ListC,  ConstC,  StrucC), 
try_block (ListC,  ListLbl,  VLink-LLink) , 
cs_block (ConstC,  Con3tLbl,  LLink-CLink,  _) , 
cs_block (StrucC,  StrucLbl,  CLink-Link,  _) , 

Code= [switch_on_term (Const Lbl, ListLbl, StrucLbl) i VCode] . 

%  Part  of  var  &  one  other  kind  optimization: 
cp_sub(list,  _,  TryLbl,  VarLbl,  TLink,  TLink,  CLS)  :-  !, 

CLS= [TryLbl,  VarLbl,  TryLbl],  !. 
cp_sub(Kind,  CompC,  TryLbl,  VarLbl,  TLink,  Link,  CLS)  :- 

(prolog_version (sbprolog)  ->  not (Kind=list) ;  \+ (Kind-list )) ,  !, 
cs_block (CompC,  BlkLbl,  BlkCode-BlkLink,  Hashed), 
cp_hash (Hashed, CSLbl, TLink, VarLbl, Link, BxkLbl, BlkCode, BlkLink) , 
cp_const_struc (Kind,  CLS,  CSLbl,  TryLbl). 

cp_hash (no_hash,  VarLbl,  Link,  VarLbl,  Link,  _,  _,  _) . 

cp_hash (yes_hash, BlkLbl,  BlkCode,  _,  Link,  BlkLbl,  BlkCode,  Link). 

cp_constjstruc (constant,  [CSLbl,  TryLbl,  TryLbl  ] ,  CSLbl,  TryLbl). 
cp_const_struc(structure, (TryLbl, TryLbl, CSLbl] ,  CSLbl,  TryLbl). 

%  Succeeds  if  first  arguments  are  all  variable  and  one  other  kind: 
same_or_var ( (clause (FArg,_,_)  I  Rest ] ,  Kind)  :- 
kindfFArg,  K) , 

(K=variable;  K=Kind) , 
same_or_var (Rest,  Kind). 
same_or_var ( ( ] ,  _) . 
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%  Succeeds  if  first  arguments  are  all  variables: 
all_var (CompC)  same_or_var (CompC,  variable) . 


compileclauses ( [C I  Clauses] ,  [clause (FArg, Lbl,  [label (Lbl)  ICode]-Link)  IRest]) 
%  ! !  getfirstarg  must  come  before  compileclause,  since 
%  compileclause  instantiates  variables  in  the  head  to  registers, 
getfirstarg (C,  FArg), 

gc  (compileclause  (C,  Code,  Link.)),  %  garbage  collect  it. 
compileclauses (Clauses,  Rest), 
compileclauses  ([]  ,  []). 

getfirstarg (Clause,  FArg)  :- 

(Clause= (Head:-Body) ;  Clause=Head) , 

Head= . . [Name  I HArgs] , 

(HArgs= [Argl l_] ;  true), 
gfa(Argl,  FArg). 

gfa(Argl,  FArg)  var(Argl),  !. 

gfa(Argl,  Argl)  atomic (Argl) ,  !. 

gfa(Argl,  Struc/Arity)  :- 

Argl=. . [StruclArgs] , 
my_length (Args,  Arity) . 

/★★★•#*★★★*★****★*★***★**★★***★★*★★★***•**★'***★★*•**★★**★*★★★★★******★***'*•/ 

%  Generate  code  for  the  four  blocks: 

%  First  block: 

%  Link  the  clauses  together  with  try_elses. 

%  Jumped  to  if  the  calling  argument  is  a  variable. 

%  Correctly  handles  cases  of  1,  2,  or  more  clauses. 

var_block ( [clause (_, Lbl, Code-Link) ] ,  Lbl,  Code-Link). 
var_block (Clauses,  Lbl,  Code-Link)  :- 

var_block  (try.  Clauses,  Lbl,  Code-Link). 

var_block(_,  [clause (_,_, C-L) ] ,  Lbl,  [ label (Lbl) , trust (else, fail) I C) -L) . 
var_b lock (Type,  [clause (_,_, C-L)  I  Clauses] ,  PrevLbl, 

(label (PrevLbl) ,InstrlC]-Link)  :- 
Instr=. . [Type, else, NextLbl] , 
var_block (retry.  Clauses,  NextLbl,  L-Link) . 

%  Filter  out  clauses  which  could  match  with  a  list,  const,  or  struc 
%  as  first  argument.  Note  that  a  variable  as  first  argument  matches 
%  with  all  of  them. 

filterlcs  (  [] ,  [],  [],  []). 

f ilterlcs  < [XIRest] ,  [XIListLbls] ,  (X IConstLbls] ,  [X  I StrucLbls] )  :- 
X=clause  (FArg,  _,  _)  , 
var  (FArg)  ,  !, 

filterlcs (Rest,  ListLbls,  ConstLbls,  StrucLbls). 
filterlcs ( [XIRest] ,  [XIListLbls],  ConstLbls,  StrucLbls)  :- 
X-clause (' . ' /2,  _,  _) , 

filterlcs (Rest,  ListLbls,  ConstLbls,  StrucLbls). 
filterlcs ( [XIRest] ,  ListLbls,  [XIConstLbls] ,  StrucLbls)  :- 
X=clause  (FArg,  _,  _)  , 
atomic (FArg) ,  !, 

filterlcs (Rest,  ListLbls,  ConstLbls,  StrucLbls) . 
filterlcs ( [XIRest] ,  ListLbls,  ConstLbls,  (X  I StrucLbls] )  :- 
filterlcs (Rest,  ListLbls,  ConstLbls,  StrucLbls). 

%  Filter  out  clauses  with  variables  as  first  argument: 

filterv( [ ] ,  [ ] ) . 

f ilterv ( [X 1  Rest ] ,  [XIVarLbls])  :- 
X-clause (FArg,  _,  _) , 
var  (FArg),  !, 
f ilterv (Rest ,  VarLbls) . 
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f ilterv ( [_ | Rest ] ,  VarLbls)  :- 

f ilterv (Rest,  VarLbls). 


%  Try  block:  Generate  a  generic  try-block  to  try 
%  all  clauses  in  the  given  list. 

%  Optimizes  code  if  only  0  or  1  clauses  are  given. 

try_block ( ( ] ,  fail,  Link-Link). 

try_block ( [clause (_, Lbl, _) ] ,  Lbl,  Link-Link). 

try_block ( (clause (_, Lbl, _) iClauses],  Label, 

[ label (Label) , try (Lbl) I LCode ] -Link)  :- 
try_block (Clauses,  LCode-Link) . 

try_block ( [clause (_, Lbl, _)] ,  [trust (Lbl)  I  Link] -Link)  :-  !. 
try_block ( [clause (_, Lbl, _) IClauses],  (retry(Lbl) ILCode] -Link)  :- 
try_block (Clauses,  LCode-Link) . 


%  Const  and  Struc  block:  First  argument  is  a  constant  or  a  structure. 
%  This  routine  works  for  both  constants  and  structures. 

%  Difference  with  try_block:  generates  hash  tables  if  needed. 

%  Variable  Hashed  indicates  if  hash  tables  were  generated. 

%  It  is  either  no_hash  or  yes_bash. 

cs_block([],  fail,  Link-Link,  no_hash) . 
cs_block ( [clause (_, Lbl, _)] ,  Lbl,  Link-Link,  no_hash) . 
cs_block (Clauses,  Lbl,  [label (Lbl) ICode] -Link,  Hashed)  :- 
cs_gather (Clauses,  [],  Gather-!],  Hashed), 
set_hashed (Hashed) , 
cs_link(try.  Gather,  Code-Link). 

%  Instantiate  argument: 
set_hashed (no_hash)  :-  !. 
set_hashed (yes_hash) . 

%  Gather  contiguous  arguments  which  are  not  variables  together. 

%  The  other  arguments  are  left  separate. 

cs_gather ( [XIRest] ,  Collect,  Gather-Link,  H)  :- 
X=clause (FArg,  Lbl,  _)  , 
var(FArg),  !, 

dump(Collect,  Gather-G,  H) , 

G-IXIG2], 

cs_gather (Rest,  [],  G2-Link,  H) . 
cs_gather ( [XIRest] ,  Collect,  Gather-Link,  H)  :- 
X=clause  (FArg,  Lbl,  _)  , 

my_member (clause (FArg, _,_) ,  Collect),  !, 
dump(Collect,  Gather-G,  H) , 
cs_gather (Rest,  [X],  G-Link,  H) . 
cs_gather ( (XIRest] ,  Collect,  Gather-Link,  H)  :- 

cs_gather (Rest,  [XlCollect],  Gather-Link,  H) . 
cs_gather ( [] ,  Collect,  Gather-Link,  H)  :- 
dump(Collect,  Gather-Link,  H) . 

%  Convert  a  collection  of  clause (s)  to  a  member  of  Gather: 

%  If  Collect  is  longer  than  one,  it  (as  list)  is  a  member. 

%  Else  just  its  element  clause  is  member, 
dump ( [ ] ,  L-L,  _) . 

dump([X],  [ X I L]  — L,  _)  :-  X=clause(_,  _,  _)  . 
dump (Collect,  (Collect  I L] -L,  yes_hash) . 

%  Link  all  elements  of  Gather  together  with  try,  retry,  trust: 

cs_link (Type,  [Gr],  Code-Link)  :- 

cs_endlink (Gr,  Type,  Code,  Link). 
cs_link (Type,  [GrlRest],  Code-Link)  :- 
cs_midl ink (Gr,  Type,  Code,  L) , 
cs_link (retry.  Rest,  L-Link)  . 
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%  Middle  hash  table  or  (re) try  instruction: 
cs_midlink (clause (_, Lbl, _) ,  Type,  [InstrIL],  L)  !, 

Instr=. . [Type, Lbl] . 

cs_midlink (Gr,  Type,  [ Instr I  Hash] ,  L)  :- 
hash(Gr,  Hash-HLink) , 

Instr= . . [Type, else, Else Lbl] , 

HLink= [label (ElseLbl) IL] . 

%  Last  hash  table  or  trust  instruction: 

cs_endlink (clause (_, Lbl, _) ,  _,  [trust (Lbl) I  Link] ,  Link)  :-  !. 
cs_endlink (Gr,  Type,  Code,  Link)  :- 
hash(Gr,  Hash-Link), 
cs_addtrust (Type,  Code,  Hash)  . 

%  Add  a  trust  if  necessary: 
cs_addtrust (try.  Hash,  Hash)  !. 
cs_addtrust  (_,  [trust  (else,  fail)  IHash] ,  Hash). 

%  Generate  hash  table  with  switch  instruction: 

%  This  routine  is  mainly  cosmetic. 
hash(Gr,  Code-Link) 

hash_table (Gr,  HashTbl-Link,  0,  HashLen) , 

Mask  is  2*HashLen-l, 
cs_kind(Gr,  Kind), 

Code= (switch (Kind, Mask, Label) , label (Label) I HashTbl] . 

%  See  if  Gr  is  a  bunch  of  constants  or  structures: 

%  No  parameter  needs  to  be  passed  to  cs_block  for  this. 
cs_kind  (  [clause  (FArg,  _,_)  |_]  ,  Kind)  :-  kind(FArg,  Kind). 

%  Construct  hash  table. 

%  Dummy  code  here: 

%  put  final  pair  on  end,  pad  with  fail  instructions 

hash_table ( (clause (FArg, Lbl,_) ] ,  [cdrpair (FArg,  Lbl)  /FailList J-Link, SoFar, Len) 
SoFarl  is  SoFar  +  1, 

ceil_2 (SoFarl, Len)  ,  %  hash  table  length  must  be  power  of  2. 

PadLen  is  Len  -  SoFarl, 
failpad (FailList , PadLen,  Link) . 

hash_table ( [clause (FArg, Lbl, _)  I  Rest ] ,  [pair (FArg, Lbl)  I  Hash] -Link,  SoFar,  Len) 
SoFarl  is  SoFar  +  1, 

hash_table (Rest,  Hash-Link,  SoFarl,  Len). 

%  General  utility:  Returns  kind  of  argument,  can  be 
%  'variable',  'list',  'constant',  'structure'. 

%  Argument  is  in  form  struc/arity  for  lists  and  structures. 

kind(Arg,  variable)  :-  var(Arg),  !. 

kind(Arg,  constant)  atomic(Arg),  !. 

kind  ('  .’  /2,  list)  :-  !  . 

kind(_,  structure). 

%  Pad  end  of  hash  table  with  pairs  of  fails, 
failpad (Link, 0, Link) . 

failpad ( (cdrpair (fail, fail)  I  Rest] , More, Link)  :- 
Ml  is  More  -  1,  failpad (Rest, Ml, Link) . 

%  Find  smallest  power  of  two  larger  than  given  value. 
ceil_2 (In, Out)  :-  ceil_2 (In, Out, 1) . 
cell_2 (In, Power, Power)  :-  In  =<  Power,  !. 

ceil_2 (In, Out , Power)  :-  Power2  is  Power*2,  cei 1_2 (In, Out , Power2) . 

/ft**************** ********»•»*»*.********»*.»„„***, „»***,,,  *»»***«***, ***y 
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%  Compile  a  Clause: 

compileclause (Clause,  Finalcode,  Link) 
pretrans (Clause,  Pretrans)  , 

Pretrans=[HeadlBody] ,  colvars (Head,  HeadVars) , 
permvars (Pretrans,  Vars,  Perms), 
unravel (Pretrans,  Unravel,  Perms), 
partobj (Unravel,  PartObj,  Perms), 
permalloc  (Perms)  , 
valvar (Partobj ,  HeadVars), 

varlist (Unravel,  VarList), 

lifetime (VarList,  LifeList,  Forward,  Backward), 
varinit (Forward,  Backward,  Partobj,  Newobj), 
tempalloc (VarList,  LifeList), 
objcode (Newobj,  ObjCode) , 
excess (ObjCode, Ob jCode2) , 
envsize (0bjCode2,  MaxSize), 
voidalloc (Ob jCode2,  VCode) , 
assn_elim(VCode,  ACode) , 

peephole (ACode,  Finalcode,  Link,  MaxSize), 


/♦it********************************************************************/ 

%  Set  utilities  used  in  the  PLM  compiler. 

%  "v"  at  the  end  of  a  name  means  no  unification  done. 


in(X,  L)  memberv(X,  L)  . 

notin(X,  L)  memberv(X,  L)  ,  !,  fail. 

notin  (X,  L)  . 

unionv (SI,  S2,  SI)  S1==S2. 
unionv( (XI  SI J ,  S2,  Res) 

memberv  (X,  S2)  ,  !, 
unionv  (SI,  S2,  Res), 
unionv ( [X  I  SI] ,  S2,  [XIRes]) 
unionv(Sl,  S2,  Res), 
unionv ( ( ] ,  S,  S)  . 

diffv ( (X  I  SI] ,  S2,  Res) 

memberv  (X,  S2)  ,  !, 

diffv  (SI,  S2,  Res)  . 
diffv ( (X  I  SI] ,  S2 ,  [XIRes]) 
diffv(Sl,  S2,  Res), 
diffv ([],  _,  []) . 

intersectv ( [X  I Setl ] ,  Set2,  Res) 

(in(X,  Setl);  notin(X,  Set2)),  !, 
intersectv(Setl,  Set2,  Res), 
intersectv ( [X I Setl] ,  Set2,  [XIRes]) 
intersectv (Setl,  Set2,  Res) . 
intersectv)  (] ,  _,  []  )  . 

includev  (X,  SI,  SI)  in(X,  SI),  !. 
includev (X,  SI,  [X  I  SI ] )  . 

/***********★***********★********#*****»**★**★***  n *********************/ 

%  List  processing  utilities  used  in  the  PLM  compiler. 

%  These  are  a  subset  of  a  much  larger  collection. 

%  list(L)  succeeds  if  and  only  if  L  is  a  list. 

%  nonlist (S)  succeeds  if  and  only  if  S  is  not  a  list. 

%  No  unification  is  done. 

list  (Term)  nonvar  (Term)  ,  Term=[_|_]. 

nonlist (Term)  list (Term),  !,  fail, 
nonlist (  ) . 
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%  full_list(I.)  succeeds  if  and  only  if  L  is  a  complete  list  (all 

%  the  cdrs  are  also  lists)  or  []. 

%  No  unification  is  done. 

full_list (L)  var(L),  !,  fail. 

full_list ( [] )  !. 

full_list ( [_| L] )  full_list (L) . 


%  concat  (Parti,  Part2,  Combined)  and 
%  my_append (Parti,  Part2,  Combined) 

%  are  true  when  all  three  arguments  are  lists,  and  the  members  of  Combined 
%  are  the  members  of  Parti  followed  by  the  members  of  Part2.  It  may  be 

%  used  to  form  Combined  from  a  given  Parti  and  Part2,  or  to  take  a  given 

%  Combined  apart.  E.g.  we  could  define  member/2  (from  SetUtl.Pl)  as 
%  member(X,  L)  my_append(_,  [XI_J,  L)  . 

concat ( ( ] ,  L,  L) . 

concat ( [H I  LI] ,  L2,  [HIRes])  concat (LI,  L2,  Res). 
my_append(A,  B,  C)  concat (A,  B,  C) . 


%  concat  (Parti,  Part2,  Part3,  Combined) 

%  concat (Parti,  Part2,  Part3,  Part4,  Combined) 

%  concat  (Parti,  Part2,  Part3,  Part4,  Parts,  Combined) 

%  are  extensions  of  concat  for  three,  four,  and  five  sublists  respectively. 
%  Concat  can  also  be  used  to  decompose  lists  into  all  combinations  of 
%  three,  four,  and  five  parts. 


concat ([] ,  L2,  L3, 

Res) 

concat (L2,  L3,  Res). 

concat ( [H | LI] ,  L2, 

L3, 

[HIRes])  concat (LI,  L2,  L3, 

Res) 

1  • 

concat  ([],  L2,  L3, 

L4 , 

Res)  concat (L2,  L3,  L4,  Res) 

. 

concat ( [H IL1 ] ,  L2, 

L3, 

L4 , 

[HIRes])  concat (LI,  L2, 

L3, 

L4,  Res) . 

concat ( [] ,  L2,  L3, 

L4 , 

L5, 

Res)  concat (L2,  L3,  L4, 

L5, 

Res)  . 

concat ( [H 1  LI] ,  L2, 

L3, 

L4 , 

L5,  [HIRes])  concat (LI, 

L2, 

L3,  L4 ,  L5 

%  length  of  a  list 

my_length ( [ ]  ,  0)  . 
my_length ( [_| L] ,  N) 

.  _ 

my_ 

length (L,  Nl) ,  N  is  Nl+1  . 

%  last (List,  Last) 

%  is  true  when  List  is  a  list  and  Last  is  its  last  element. 

%  This  could  be  defined  as  last(L,X)  my_append(_,  [X],  L) . 

last ([Last],  Last)  !. 

last ( [_| List ] ,  Last)  lastlList,  Last). 


%  my_member (Elem,  List) 

%  is  true  if  Elem  is  a  member  of  List.  This  can  be  used  as  a  checker, 

%  as  a  generator  of  elements,  or  as  a  generator  of  lists. 

my_member(X,  [X  I  _] )  . 

my_member(X,  [ I  L  ] )  my_member(X,  L)  . 


%  memberchk (Elem,  List) 

%  same  as  member,  but  used  only  to  test  membership. 

%  This  is  faster  and  uses  less  memory  than  the  more  general  version. 

%  memberv  does  not  use  unification  to  test  for  membership. 

memberchk (X,  [ X  I _ ] )  !. 

memberchk (X,  [_IL])  memberchk (X,  L) . 
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memberv(X,  [ Y I _ ] )  X==Y,  !. 

membervIX,  [_|L])  membervfX,  L)  . 


%  reverse (List,  Reversed) 

%  is  true  when  List  and  Reversed  are  lists  with  the  same  elements 
%  but  in  opposite  orders,  rev/2  is  a  synonym  for  reverse/2. 

rev(List,  Reversed)  reverse (List,  (],  Reversed). 

reverse (List,  Reversed)  reverse (List,  (],  Reversed). 

reversed],  Reversed,  Reversed), 
reverse ( (Head  I  Tail] ,  Sofar,  Reversed)  :- 

reverse  (Tail,  [Head  I Sofar ] ,  Reversed). 


%  flatten (List,  FlatList-Link) 

%  flattens  a  list  by  removing  all  nesting.  FlatList  consists  of 
%  all  atoms  nested  to  any  depth  in  List,  but  all  on  one  level. 

flatten([],  Link-Link), 
flatten ([AIL],  [AIF]-Link)  :- 

(atomic (A) ; var (A) ) ,  !,  flatten (L,  F-Link) . 
flatten ([AIL],  F-Link)  :- 

flatten (A,  F-FL) ,  flatten (L,  FL-Link) . 


%  mapcar (Structure,  Listl,  List2) 

%  Calls  the  goal  Structure+elem  of  Listl+elem  of  List2  for  each  pair 
%  of  elements  of  Listl  and  List2. 

%  generalization  of  the  Lisp  function  mapcar. 

mapcar (Call,  Listl,  List2)  :-  ! , 

Call-. . (Func lArgs] , 

xmapcar (Func,  Args,  Listl,  List2) . 

xmapcar (Func,  Args,  [A|L1],  [BIL2])  :-  !, 

concat (Args,  [ A, B] ,  GoalArgs) , 

Goal- .  .  (Func  I  GoalArgs] , 
call (Goal) ,  ! , 

xmapcar (Func,  Args,  LI,  L2) . 
xmapcar (_,  _,  (] ,  [] )  . 

%  mapcar (Functor,  Listl,  List2,  List3) 

%  same  as  Lisp's  mapcar,  except  has  three  arguments. 

mapcar(Func,  [ A I  LI ] ,  [B|L2],  [C|L3])  :-  !, 

Term- .. [Func,  A,  B,  C], 
call  (Term)  ,  ! , 

mapcar(Func,  LI,  L2,  L3) . 
mapcar  (_,  []  ,  []  ,  [] )  . 


%  listify (Structure,  ListForm) 

%  converts  a  general  structure  to  a  Lisp-like  list  form. 

listify  (X,  X)  :-  (atomic  (X);  var(X)),  !. 
listify (Structure,  [Func I LArgs] )  :- 
Structure- . . [Func I Args] , 
mapcar (listify,  Args,  LArgs). 


%  linkify (List,  DiffList-Link) 

%  converts  a  list  into  a  difference  list. 
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linkify([],  Link-Link). 

linkify ( ( A I  List ] ,  [A  I Dif fList ] -Link)  :- 
linkify  (List,  Dif fList-Link) . 

/******'#**■*•*********★***■*•****★**■*■#****•********★***■****#******★**★***★**/ 

%  Special  utilities  used  by  the  clause  compiler: 

%  Built-in  procedures  which  do  not  destroy  any 
%  argument  registers: 

%  Includes  arity  so  user  can  define  routines  with  same 
%  name  but  different  arity. 
escapejouiltin (Goal)  :- 

Goal=. . [Name  I Args] , 
myjength  (Args,  Arity), 
escape_builtin (Name,  Arity). 

%  Note:  The  escape_builtins  not,=,+  are  done  in  pretrans. 

%  The  unify  operator  '='  is  part  &  parcel  of  the  compiler. 

%  However,  all  four  must  be  listed  here  for  correct  compilation. 

%  12/4  -  added  escapejouiltin  routines  to 
%  handle  global  variables,  set  and  access. 

%  -  Wayne 

%  Some  of  the  escape_builtins  are  implemented  with  existing  instructions 
escape_builtin  ( ! ,  0). 

escapejouiltin ('->', 0) .  %  For  correct  compilation  of  if-then-else . 
escapejouiltin  (nl,  0). 
escapebuiltin (true,  0). 
escape_builtin (fail,  0). 
escape_builtin (repeat,  0). 

%  escapejouiltin  ('  +'  ,  1). 
escapejouiltin  (var,  1). 
escapebuiltin (' not' ,  1). 
escapejouiltin  (atom,  1). 
escape_builtin (list,  1). 
escapejouiltin  (write,  1). 
escapejouiltin  (writeq,  1). 
escapejouiltin  (nonvar,  1). 
escapejouiltin  (atomic,  1). 
escapejouiltin  (number,  1). 
escapejouiltin  ( integer,  1). 
escapejouiltin  (nonlist,  1). 
escapejouiltin  (structure,  1). 
escapejouiltin  ('='  ,  2). 
escapejouiltin  ('  <'  ,  2). 
escapejouiltin  ( '  >'  ,  2). 
escapejouiltin  ( '  ==' ,  2). 

%  escapejouiltin  ( '  =  '  ,  2). 
escapejouiltin  ('  <='  ,  2). 
escapejouiltin  ('  =<' ,  2). 
escapejouiltin  ( '  >='  ,  2). 

%  escapejouiltin  ('  ==' ,  2). 
escapejouiltin  ('=..'  ,  2). 
escapejouiltin  (set,  2)  . 
escapejouiltin  (access,  2)  . 
escapejouiltin  ('  is' ,  2). 
escapejouiltin  ( '  +’  ,  3). 
escapejouiltin (' ,  3). 

%  escapejouiltin  ('  /  ',  3). 

%  escapejouiltin  (' /' ,  3). 
escapejouiltin  ('  is' ,  4). 
escapejouiltin  (functor,  3). 
escapejouiltin  (arg,  3). 
escapejouiltin  (name,  2)  . 
escapejouiltin  (system,  1)  . 
escape Jouiltin (consult, 1)  . 
escapejoui ltin  (reconsult,  1)  . 


%  for  global  variables 
%  for  global  variables 


%  Added  11/15/86. 
%  Added  1/15/87. 
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%  additional  Duiit-ins  not  in  original  list. 

%  escape_builtin  ('  »\  =  '  ,  2)  . 
escape_builtin  ('  o'  ,  2)  . 
escape_builtin (abolish, 2) . 
escape_builtin (assert, 1)  . 

%  escape_builtin (call, 1) .  Because  call/1  kills  temporari 

escape_builtin (length, 2) . 

escape_builtin (put, 1) . 

escape_builtin (get, 1) . 

escape_builtin (getO, 1)  . 

escape_builtin (read, 1) . 

escape_builtin (retract, 1) . 

escape_builtin (see, 1) . 

escape_builtin (seen, 0) . 

escape_builtin (tab, 1) . 

escape_builtin (tell, 1)  . 

escape_builtin (told, 0) . 


%  Get  type  and  argument  of  an  instruction: 
type_arg  (get  (T,  R,  X)  ,  T,  R)  . 
type_arg  (put  (T,  R,  X)  ,  T,  R)  . 
type_arg  (unify  (T,R)  ,  T,  R)  . 

%  Maximum: 

max (A,  B,  A)  A>=B,  !. 
max (A,  B,  B)  A=<B,  !. 

%  Collect  variables  in  a  structure, 
colvars (S,  Vars)  :- 
S=. . [_|SL] , 
split_avs (SL,  Vars). 
split_avs ( [ A I Args] ,  Vars)  :- 
atomic (A),  !, 

split_avs (Args,  Vars). 
split_avs ( (VI Args] ,  Vars) 
var(V),  !, 

split_avs (Args,  VL) , 
includev(V,  VL,  Vars). 
split_avs ( (S I Args] ,  Vars)  :- 
S= . . (_|SA] , 
split_avs (SA,  VL1) , 
spl it_avs (Args,  VL2 ) , 
unionv(VLl,  VL2,  Vars). 
split_avs  (  []  ,  ( ]  )  . 

%  Extract  all  variable  terms  from  input  list 
%  and  put  them  in  a  difference  list: 
getvars (V,  (V| Link] -Link)  :-  var(V),  !. 

getvars (V,  Link-Link)  :-  nonlist (V),  ! . 

getvars ( (V| List ] ,  Out)  :- 
var (V) ,  ! , 

Out- (VI Vars] -Link,  %  Changed  for  bug  in  v2 . 1  BIM-Prolog 
getvars (List ,  Vars-Link) . 
getvars ( (X  I  List ] ,  Vars-Link)  :- 
nonvar  (X)  ,  ! , 
getvars (List,  Vars-Link). 
getvars(fj,  Link-Link). 


%  Mapping  utilities  for  G.P.  traversing  of 
%  clause  code. 

\  1.  Map  over  a  clause  (no  dependencies): 

%  Result  has  same  structure  as  input. 

%  Call  may  be  a  structure  with  one  argument, 
mapclause (Call ,  [XIXRest],  (YlYRestJ)  :- 

x- !, 

mapdis (Call,  X,  Y) , 
mapclause (Call,  XRest,  YRest). 


.  11/16/86. 
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mapclause (Call,  [XIXRest],  [YiYRest])  : - 
Call- . . List , 

concat(List,  [ X , Y ] ,  GoaiList), 
G=.  .GoaiList, 
call (G) , 

mapclause (Call,  XRest,  YRest). 
mapclause (_,  [],  []). 

mapdis  (Call,  (X;XRest)  ,  (Y;YRest))  :- 
mapclause (Call,  X,  Y)  , 
mapdis(Call,  XRest,  YRest). 
mapdislCall,  X,  Y) 

mapclause (Call,  X,  Y) . 


%  2.  Mapclause  with  three  inputs: 

mapclause (Call,  [XIXRest],  [YlYRest],  (ZiZRest)) 

X= (_;_),  !, 

mapdis(Call,  X,  Y,  2), 
mapclause (Call,  XRest,  YRest,  ZRest). 
mapclause (Call,  [XIXRest],  [YlYRest],  [ZiZRest])  :- 
Call-.  .  [A] , 

G=  .  .  [A,  X,  Y,  Z  ]  , 
call (G) , 

mapclause (Call,  XRest,  YRest,  ZRest). 
mapclause  (_,  [],  [],  []). 

mapdis  (Call,  (X;XRest),  (Y; YRest),  (Z;ZRest>) 
mapclause (Call,  X,  Y,  Z) , 
mapdis(Call,  XRest,  YRest,  ZRest). 
mapdis  (Call,  X,  Y,  Z) 

mapclause (Call,  X,  Y,  Z) . 


%  Repeat  loop  in  Prolog. 

%  by  Warren. 

%  range (10, I, 30)  succeeds  with  1=10,  11,  ...,  30,  and  then  fails. 

%  range (L, L, L)  : -  !  . 

%  range (L, I,  H)  :  - 
%  K  is  (H+L) 112, 

%  range  (L,  I,  K)  . 

%  range  (L,  I,  H)  :  - 
%  K  is  1+  (H+L)  112, 

%  range (K, I,  H)  . 

range  (L,  L,  H)  . 

range(L,I,H)  L<H,  LI  L+l,  range  (LI,  I,  H)  . 
/****»**»******«**«»«**»*»***»****«***********»************»,*»*******  * / 
%  Memory  management:  cleaning  up  of  the  heap. 
gc(Call)  :- 

%  pro log_ver sion (cprolog) , 

c_gc (Call)  . 

%  Can  use  same  trick  on  bimprolog 
%gc(Call) 

%  prolog_version (bimprolog) , 

%  call (Call) . 

c_gc(Call)  :-  one_call  (Call)  ,  lock  (Call). 
c_gc(Call)  :-  unlock  (Call)  . 

one_call (Call)  call  (Call),  !. 

lock  (Term)  :  - 

abolish ( info_lock,  1), 
assert (info_lock (Term) ) ,  fail. 
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unlock  (Term) 

retract ( info_lock (Term) ) , 
abolish ( info_lock,  1). 

/********■****★*★***»**************«**************★**★***■*****★*****★**★/ 

%  10  Package 

%  Arity  of  the  compiled  code  never  goes  above  7,  but  the  actual  arity 
%  of  the  predicate  is  output  here  in  order  to  distinguish  predicates 
%  with  arities>7. 

write_plm (NameArity,  List) 

compile_options  (1)  ,  !, 

write_plm_list (NameArity,  List),  nl,  nl,  !. 
writeplm (NameArity ,  List)  :- 

(prolog_version ( sbprolog)  ->  not (compi le_opt ions ( 1) ) ; 

\+ (compiie_options (1) ) ) ,  !, 

write_plm_nice (NameArity,  List),  nl,  nl,  !. 

%  Write  the  procedure  code  in  human-readable  form: 
write_plm_nice (NameArity,  List)  :- 

write (' procedure  '),  write (NameArity) ,  nl,  nl, 
write_plm_nice (List) . 

write_plm_n ice ( [ 1 1  List ] ) 
winstr  (I)  , 

write_plm_nice (List) ,  !. 

write_plm_nice ( ( ] )  . 

%  Write  the  procedure  code  in  list-form,  able  to  be  read  by  read/1: 
write_plm^list (NameArity,  List)  :- 

write  ('  (procedure  (' )  ,  writeq  (NameArity)  ,  write('),'),  nl, 
write_plm_list (List) , 
write  (']•')  • 

write_plm_list ( [I] )  :- 

writeq  ( I)  . 

write_plm_list ( [ 1 1  List ) /  :- 

writeq(I),  comma,  nl, 
write_plm_l ist (List)  . 
write_plm_list ( [ ) ) . 

%  Write  arguments  separated  by  commas: 
wcomma([A])  :-  warg(A),  nl. 
wcomma ( [ A I L] )  :-  warg(A),  comma,  wcomma (L) . 
wcomma ( [ ] )  : -  nl . 

%  Write  a  label  or  constant  label: 

wlbl (L)  :-  var(L),  compi le_opt ions (a (A) ) ,  atomic (A) ,  !, 

write(L),  und,  write(A). 
wlbl  (L)  :-  var(L),  !,  write  (L). 
wlbl (X)  :-  write(X). 

%  Write  an  argument: 

warg(Lbl)  :-  var(Lbl),  wlbi(Lbl).  %  var/1  needed  here. 
warg(x(I))  :-  write('X'),  write(X),  !. 
warg(yd))  :-  write('Y'),  write(I),  !. 
warg(N)  :-  number  (N),  write('S'),  write  (N),  !. 

warg(C)  :-  compile_opt  ions  (q) ,  write  (""),  write  (C) ,  write  ('"') ,  !. 

warg(C)  :-  (prolog_version (sbprolog)  ->  not!compile_options(q)); 

\+ (compile_options (q) ) ) ,  writeq (C),  !. 
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%  Write  a  single  instruction  on  a  line: 
winstr(X)  atomic(X),  wtabln(X). 
winstr (fail/0)  wtabln  (fail)  . 
winstr  (label  (L)  )  wlbl (L) ,  win  (':'). 

winstr (execute (L) )  wtab (execute) ,  space,  wlbl(L),  nl. 

winstr (cutd (L) )  wtab(cutd),  space,  wlbl (L) ,  nl. 
winstr  (pair  (A,  B) )  tabl,  warg(A),  nl,  tabl,  wlbl  (B)  ,  nl. 
winstr (cdrpair (A, B) )  A==fail,  B==fail, 

wtab(fail),  wtabln (tcdr) ,  wtabln (fail) . 
winstr (cdrpair (A, B) )  tabl,  warg(A),  wtabln (tcdr) ,  tabl,  wlbl (B) ,  nl. 

winstr (switch_on_term (A, B, C) )  :- 

wtab (switch_on_terra) ,  space,  wcorama ( [A, B, C] ) . 
winstr (switch (Kind, Mask, Lbl) ) 

wtab(switch_on_) ,  write(Kind),  space, 
write (Mask) , comma, wlbl (Lbl) , nl . 
winstr  (unify  (void,  N)  )  wtab  (unify_void)  ,  space,  wln(N). 
winstr (Instr) 

Instr= . . [Name, Type  I Args] , 

(Name=unify;  Name=get;  Name=put), 
wtab(Name),  und,  write (Type),  space, 
wcomma (Args) . 
winstr (Instr ) 

Instr=. . [Name,Argl I Args] , 

(Name=try;  Name=retry;  Name=trust), 
wtab (Name) , 

write_else (Argl,  Args). 
winstr (Instr) 

Instr= . . (Name, Arg] , 

(Name=get_nil;  Name^put__nil;  Name=get_list;  Name=put_list)  , 
wtab(Name),  space,  warg(Arg),  nl. 
winstr (Instr) 

Instr=. . [Name, Arg] , 
wtab(Name),  space,  wln(Arg). 
winstr (call (Name, N) ) 

wtab (call),  space, 
write (Name) , comma, win (N) . 
winstr (Name/Arity) 

wtab (escape) ,  space,  win (Name/Arity) . 

%  Write  a  space,  comma,  or  underline  character: 
space  : -  write  ( '  ' )  . 

comma  write (','). 
und  : -  write ( ' _' ) . 

%  Tab  before  or  newline  after: 
wtab(X)  :-  tabl,  write  (X). 
wln(X)  :-  write(X),  nl. 
wtabln(X)  tabl,  write(X),  nl. 
tabl  :-  put (9)  . 


w(Expr)  :-  X  is  Expr,  write(X). 

wl([AIRest])  :-  write(A),  nl,  wl(Rest). 
wl  ( [ ] )  nl . 

write_else (Argl,  Args)  :-  Argl==else,  !, 
write (' _me_else  '), 

Args=[L],  wlbl (L) ,  nl. 
write_else (Argl,  _)  :- 

space,  wlbl (Argl),  nl. 

/****»»***********************•***»*»***»***»**********************»****/ 

%  Pretransformations:  Recognize  source  forms 
%  and  transform  to  forms  which  can  be  compiled. 

%  Also  transform  conjunction  into  list  form. 
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pretrans ( (Head:-Body) ,  [PHIPBJ)  :- 

%  Transform  head  according  to  change  of  12/20  (below) . 
arity_limit (Head,  PH), 
pretrans  (Body,  PB,  []),  !. 
pretrans (Head,  (PH])  arity_limit (Head,  PH). 

%  Addition  -  4/16 

%  Transform  list  form  of  consult  and  reconsult 
%  into  explicit  calls  to  consult  and  reconsult. 

%  Transform  a  disjunction: 
dis  jpret  rans  (Dis  j ,  (PX;PB)  )  :- 
dis  jtest  (Dis  j.  A,  B)  , 
nonvar  (A)  ,  A=(X  ->  Y)  ,  !, 

pretrans(X,  PX,  ('— >'  IPY]), 
pretrans  (Y,  PY,  []), 
dis jpretrans (B,  PB) . 
dis jpretrans (Dis j,  (PA;PS) ) 

dis  jtest  (Dis  j.  A,  B)  ,  !, 

pretrans  (A,  PA,  []), 
dis  jpretrans  (B,  PB)  . 
dis jpretrans (Last,  (PX;[fail]))  :- 

nonvar (Last) ,  Last=(X->Y),  !, 
pretrans  (X,  PX,  ['->'IPY]), 
pretrans  (Y,  PY,  []). 
dis jpretrans (Last,  PL) 

pretrans  (Last,  PL,  []). 

dis  jtest  (Disj,  A,  B)  nonvar  (Dis  j)  ,  Disj=(A;B). 

%  Bug  fix  -  11/29/84 

%  Transform  goal  consisting  of  single  variable  to  call. 

%  I'm  not  sure  if  this  is  really  semantically  correct,  but  goals 
%  of  this  form  are  not  handled  elsewhere  and  C-Prolog  handles 
%  them  this  way.  -  Wayne 

pretrans (X,  (call (X) ILink] ,  Link)  var(X),  !. 

pretrans (call (X) ,  PX,  Link) 

pretrans (X,  PX,  Link). 

pretrans (not (A) ,  ( (PA; (true] )  I  Link] ,  Link)  :- 

pretrans(A,  PA,  ('->', fail] ) . 
pretrans (\+ (A) ,  [ (PA; [true ]) i Link] ,  Link) 

pretrans(A,  PA,  ('->',  fail] )  . 

%  Lone  (X->Y)  not  in  a  disjunction: 
pretrans ((X  ->  Y) ,  [ (PX; (fail] )  I  Link] ,  Link)  :- 
pretrans (X,  PX,  ( ' ->' I PY] ) , 
pretrans  (Y,  PY,  []). 
pretrans ( (Goal, Body) ,  PG,  Link) 
pretrans  (Goal,  PG,  PB)  , 
pretrans (Body,  PB,  Link), 
pretrans (Dis j,  [PDILink],  Link)  :- 
Disj- <_;_) , 

disjpretrans (Dis j,  PD). 

%  pretrans  (' \=*'  (X,  Y)  ,  [( (X-Y,  fail]  ;  (true  J )  I  Link] ,  Link). 

%  Transform  is/2  into  is/4  if  not  using  option  'u'. 
pretrans((V  is  Exp),  Is4,  Link) 
expr_nolist (Exp,  NExp) , 
top_express ion (NExp,  V,  Is4,  Link). 

%  transform  list  form  of  re/consult  to  explicit  call 
pretrans (List,  Consult,  Link)  :- 
full_list (List) , 

expand_consult (List,  Consult,  Link). 

%  Transform  subgoal  according  to  change  of  12/20. 
pretrans (Goal,  (PGILink],  Link)  :-  arity_limit (Goal,  PG) . 
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%  Transform  an  expression  of  the  form  X  is  Expr 
%  into  a  series  of  is/4  calls. 

%  Recognizes  unary  minus  and  converts  all  binary  operators. 

%  Unrecognized  forms  are  kept  in  is/2. 

%  Bug  fix  1/15/87:  does  'V  is  W'  correctly,  where  V  s  W  are  vars. 

%  Top  level  call  recognizes  special  cases  of  top  level. 
top__expression  (Expr,  X,  (fail  (Link],  Link) 

%  X  is  atom  or  struc  or  list, 
nonvar (X) , 

(prolog  version (sbprolog)  ->  not (number (X) ) ;  \+ (number (X) )) , 
top_expression (Expr,  X,  ( (X  =  Expr)  I  Link),  Link) 
number (Expr) ,  ! . 

topexpression (Expr,  X,  [(X  is  Expr) [Link],  Link) 

(var(Expr);  atomic  (Expr)  ) ,  !. 

top_expression (Expr,  X,  Code,  Link) 

(prolog_version (sbprolog)  ->  not (compile_options  (u) ) ; 

\+ (compile_options (u) ) ) ,  !, 

expression  (Expr,  X,  Code,  Link), 
top  expression  (Expr,  X,  ((X  is  ExprHLink],  Link) 
compile_opt ions (u) ,  !. 

express  ion ( IExpr,  IExpr,  Link,  Link)  var(IExpr),  !. 

express ion ( IExpr ,  IExpr,  Link,  Link)  number ( IExpr) ,  !. 

express  ion  (- (El )  ,  OExpr,  Code,  Link)  !, 

expression  (El ,  Al,  Code ,  [ '  is'  (OExpr  ,0,'-',Al)  )  Link.] )  . 

expression (IExpr,  OExpr,  Code,  Link) 
compile_options (s)  , 

IExpr-.. (Op,  El,  E2], 

my_member  (Op,  ['+',  /*  ,  '/\',  '\/'  */]),  !, 

Pred= . . (Op,  Al,  A2,  OExpr], 
expression (El,  Al,  Code,  LI), 
expression (E2,  A2,  LI,  [Pred | Link] ) . 
expression (IExpr,  OExpr,  Code,  Link) 

IExpr=..[Op,  El,  E2),  !, 

expression (El,  Al,  Code,  Ll)  , 

expression (E2,  A2,  Ll,  ('is'  (OExpr , Al , Op, A2)  ILinkJ)  . 
expression (IExpr,  OExpr,  ((OExpr  is  IExpr)  I  Link] ,  Link). 

%  Bug  fix  5/17/87:  recognizes  [expr]  correctly  in  expressions. 

%  Transform  [expr]  to  expr  recursively: 

%  This  makes  is/2  compatible  with  C-Prolog: 
expr_nolist (IExpr,  IExpr)  var(IExpr),  ! . 
expr_nolist (IExpr,  IExpr)  :-  number ( IExpr) ,  !. 

expr_nolist ( IExpr,  IExpr)  :-  atomic ( IExpr ) ,  !. 

expr_nolist ( [IExpr] ,  OExpr) 

expr_nolist (IExpr,  OExpr),  !. 
expr_nolist ( IExpr,  OExpr) 

IExpr= . . [Op  I lArgs ) , 

mapcar  (expr_nol  ist,  IArgs,OArgs)  , 

OExpr= . . [Op  I OArgs ]  . 

%  Expand  consult  shorthand  into  explicit  calls  to  re/consuit: 

%  Ignore  nonatomic  items  in  the  consult  list. 
expand_consult ( [ ] ,  Link,  Link). 

expand_consult ( [File  I  List ] ,  [consu It (F i le )  I  Consult ] ,  Link)  :- 
(var (File) ;atom(File) ) ,  !, 

expand_consult (List,  Consult,  Link). 
expand_consult ( [-File  I  List] ,  [  reconsu  It (F i le)  I Consu It ] ,  Link) 

(var (File) ;atom(File) ) ,  ! , 

expand  consult (List,  Consult,  Link), 
expand  consult ( [Other  I  List ] ,  Consult,  Link) 
expandconsult (List,  Consult,  Link). 
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%  Addition  -  12/20 

%  If  >  7  arguments  to  a  call,  force  all  arguments  after  the  first  six  into 
%  a  structure  passed  as  the  seventh  argument.  Must  be  done  for  heads  and 
%  subgoals  in  body.  -  Wayne 
arity_limit  (Pred,  PH)  :- 

functor (Pred,  Functor,  Arity) ,  Arity  >=  8,  !, 

Pred  =..  (Functor,  Al,  A2,  A3,  A4,  A5,  A6  I  Rest), 

RestArgs  =..  [dummy  !  Rest], 
rename_goal (Functor,  Arity,  NewFunctor) , 

PH  =..  [NewFunctor,  Al,  A2,  A3,  A4,  A5,  A6,  RestArgs). 
arity_limit  (Pred,  NewPred)  :- 

functor  (Pred,  Functor,  Arity), 
rename_goal (Functor,  Arity,  NewFunctor), 

Pred= . . [Functor  I Args] , 

NewPred= . . [NewFunctor I Args) . 

%  Embed  arity  into  the  functor  name: 

%  Only  done  for  nonbuiltins. 
rename_goal (Functor,  Arity,  Functor)  :- 

escape_builtin (Functor,  Arity),  !. 
rename_goal (Functor,  Arity,  NewFunctor)  :- 
name (Functor,  FList) , 
to_string (Arity,  AList,  []), 
name (' /' ,  [Slash] ) , 

concat (FList,  [Slash  I AList ) ,  NFList) , 
name (NewFunctor,  NFList). 

%  Convert  an  integer  into  a  string: 
to_string(N,  [DILink],  Link) 

N<10,  !, 

name ( ' 0' ,  (Zero) ) , 

D  is  N+Zero. 

to_string(N,  String,  Link)  :- 
name  {'O',  [Zero]), 

D  is  (N  mod  10)  +  Zero, 

N1  is  IN  //  10), 

to_string (Nl,  String,  [DILink]). 

/*******★**■**************#********************■***********************'**/ 

%  All  structures  are  unraveled  into  unify  goals. 

%  All  unify  goals  are  of  the  form  Varl=(Var2  or  Atom  or  Struc), 

%  where  Varl  is  temporary  or  permanent  and 
%  where  Struc  has  only  variables  and  atoms  as  arguments. 

%  If  Varl  is  permanent  then  so  is  Var2 . 

%  Preexisting  unify  goals  are  transformed  into  this  type, 

%  The  structure  of  disjunctions  remains  the  same  (i.e. 

%  the  operator  ';'  remains).  Only  the  content  is  unraveled. 

%  Bug  fix  -  7/31/85: 

%  Handle  case  where  the  null  list  is  an  element  of  a  list  or  a  structure. 
%  -  Wayne 

unravel ( (Head | Body ] ,  [NewHead I  Ravel ] ,  Perms)  :- 
spread (Head,  NewHead,  Ravel-L), 
xunravel (Body,  L- [ ) ,  Perms),  !. 

xunravel ( [Dis I  Rest ] ,  (DRavel I  Rave  1 ) -Link,  Perms)  :- 
Dis=  (_;_)  , 

disunravel (Dis,  DRavel,  Perms), 
xunravel (Rest,  Ravel-Link,  Perms), 
xunravel ( (Goal  I  Rest ) ,  Ravel-Link,  Perms)  :- 
Goal= (_=_) , 

varunify (Goal,  Ravel-L,  Perms), 
xunravel (Rest,  L-Link,  Perms), 
xunravel ( (Goal IRest] ,  Ravel-Link,  Perms)  :- 
spread (Goal,  NewGoal,  Ravel-L), 

L= (NewGoal I L2] , 

xunravel (Rest,  L2-Link,  Perms), 
xunravel ([],  Link-Link,  ). 
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disunravel ( (A, -B) ,  (ARavel;BRavel) ,  Perms)  !, 
xunravel (A,  ARavel-[],  Perms), 
disunravel  (B,  BRavel,  Perms), 
disunravel  (A,  ARavel,  Perms) 

xunravel(A,  ARavel-[],  Perms). 


%  Unification  optimization. 

%  Turn  the  general  goal  ' X=Y'  into  a  sequence 
%  of  simpler  unifications  of  the  form 
%  Varl=(Var2  or  Atom  or  Struc) , 

%  where  Varl  is  a  temporary  or  permanent  variable,  and 
%  where  Struc  has  only  atoms  and  variables  as  arguments, 
varunify (X=Y,  Code-Link,  Perms)  :- 

(xvarunify (X=Y,  Code-Link,  Perms);  Code= [ f ail  I  Link ] ) . 

%  One  argument  is  a  temporary  variable: 
xvarunify (A=B,  [A=NewB I L] -Link,  Perms)  :- 
var(A),  notin (A, Perms) ,  !, 

spread  (B,  NewB,  L-Link)  . 
xvarunify (A=B,  [8=NewA I L] -Link,  Perms)  :- 
var(B),  notin (B, Perms) ,  !, 
spread (A,  NewA,  L-Link). 

%  One  argument  is  a  permanent  variable: 
xvarunify (A=B,  (A=NewB I L] -Link,  Perms)  :- 
in  (A,  Perms)  ,  ! , 
spread (B,  NewB,  L-Link). 
xvarunify  (A=B,  [B=NewA I L] -Link,  Perms)  :- 
in  (B,  Perms)  ,  ! , 

spread (A,  NewA,  L-Link). 

%  Both  arguments  are  nonvariables: 
xvarunify (A=B,  Link-Link,  Perms)  :- 

atomic (A),  !,  atomic (B),  A=B . 

xvarunify (A=B,  Code-Link,  Perms)  :- 
atomic (B) ,  ! ,  fail . 

xvarunify (A=B,  Code-Link,  Perms)  :-  %  ASB  are  structures 
A- . . [Func I ArgsA] , 

B= . . [Func I ArgsB] , 

lvarunify (ArgsA,  ArgsB,  Code-Link,  Perms) . 

lvarunify ( [ A I ArgsA] ,  (B I ArgsB] ,  Code-Link,  Perms)  :- 
xvarunify (A=B,  Code-L,  Perms),  !, 
lvarunify (ArgsA,  ArgsB,  L-Link,  Perms), 
lvarunify ((],  [],  Link-Link,  Perms). 


%  Take  a  (possibly  nested)  structure  apart  into 
%  (1)  a  simple  structure,  and  (2)  a  series  of  unify  goals. 
%  A  list  is  considered  as  a  structure  with  variable  arity. 
%  Its  cdr  field  is  given  a  separate  unify  goa'  to 
%  accommodate  the  unify_cdr  instruction. 
spread(Var,  Var,  Link-Link)  :-  var(Var),  !. 
spread (Atomic,  Atomic,  Link-Link)  :-  atomic (Atomic) ,  !. 

spread(List,  SimpleList,  Rest-Link)  :- 
list (List) ,  ! , 

argspread(CdrUnify,  List,  SimpleList,  Ravel-Link), 
check_cdr (CdrUnify,  Ravel,  Rest), 
spread (Struc,  SimpleStruc,  Rest-Link)  :- 
St ruc= . . [Name  I Args] , 

argspread(_,  Args,  VArgs,  Rest-Link), 

SimpleStruc=. . [NamelVArgs) . 

check_cdr (none,  Ravel,  Ravel)  :-  !. 
check_cdr (CdrUnify,  Ravel,  [CdrUnify IRavel] ) . 

argspread (none,  Cdr,  Cdr,  Link-Link)  :- 
(var (Cdr) ;Cdr== [ ] ) ,  !. 

argspread 'T=SimpleCdr,  Cdr,  T,  Ravel-Link)  :- 
nonlist  (Cdr)  ,  ! , 

spread (Cdr,  SimpleCdr,  Ravel-Link). 
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%  arg  is  null  list 

argspread (CdrUnify,  (SlArgs],  [TIVArgs], 
nonvar  (S)  ,  S  =  U  ,  ! , 

argspread (CdrUnify,  Args,  VArgs, 
argspread (CdrUnify,  [AlArgs],  (AIVArgs], 
(atomic (A);  var(A)),  ! , 
argspread (CdrUnify,  Args,  VArgs, 
argspread (CdrUnify,  [SlArgs],  [TIVArgs], 
Ravel= [T=V I L] , 
spread(S,  V,  L-L2) , 
argspread (CdrUnify,  Args,  VArgs, 


[T-[]  I L] -Link)  :  - 


L-Link)  . 
Ravel-Link!  :- 


Ravel-Link) . 
Ravel-Link)  :- 


L2-Link) . 


/***W****************»******WW**********«*******************'W**********/ 

%  Convert  unraveled  code  into  partial  object  code: 

partobj ( [Head ISodyGoals] ,  [HeadOb j I BodyOb j ] ,  Perms) 

Head= . . [_| Args] , 

getputblock (get,  Args,  HeadOb j,  1), 
xpartobj (BodyGoals,  Perms,  BodyObj,  yes),  !. 


xpartob j  (  [],  _,  [] ,  _)  . 

xpartobj ( [Ois IRest] ,  Perms,  Result,  Flag) 

Dia- (_;_),  ! , 

%  Initialize  permanent  variables  just  before  first  disjunction: 
initperms (Flag,  Perms,  Result,  [DisCode I RestCode ] ) , 
dispartobj  (Dis,  Perms,  DisCode) , 
xpartob j (Rest,  Perms,  RestCode,  no), 
xpartobj ( [Goal IRest] ,  Perms,  [GoalCode I RestCode ] ,  Flag)  :- 
goalpartobj (Goal,  Perms,  GoalCode) , 
xpartobj (Rest,  Perms,  RestCode,  Flag). 

initperms (yes.  Perms,  (Perralnit IR] ,  R)  !, 

initblock  (Perms,  Permlnit)  . 
initperms (_,  _,  R,  R) . 

dispartobj  (  (A;B) ,  Perms,  (ACode;BCode) )  :- 

xpartobj (A,  Perms,  ACode,  no), 
dispartobj (B,  Perms,  BCode) . 
dispartobj (A,  Perms,  ACode)  :- 

xpartobj (A,  Perms,  ACode,  no). 


%  Convert  goals  into  their  object  code: 

%  Recognizes  !,  true,  unify  goals,  and  calls  with  simple  arguments: 


%  Convert  ’!'  into  cut  instruction: 
goalpartobj (! ,  _,  (cut  I  Link J -Link)  . 

%  Cut  in  a  disjunction  is  handled  for  objcode: 
goalpartobj ('->' ,  _,  cutd) .  %  Note:  not  a  list,  so  objcode 
%  'true'  needs  no  code: 
goalpartobj (true,  _,  Link-Link)  . 

%  translation  of  unify  goals: 

goalpartobj (V-W,  Perms,  [put (_, V, Temp)  I  Code ] -Link)  :- 
unify_temp (V,  Perms,  Temp), 
uni fy_2ndpart (W,  Temp,  Code-Link). 

%  translation  of  other  goals: 
goalpartobj  (Goal,  _,  Code-Link)  :- 
Goa 1  = . . ( Name  I Args  J , 
my_length (Args,  Arity) , 
getputblock (put ,  Args,  Code-L,  1), 
goal_call (Name,  Arity,  L,  Link) . 

%  Get  the  temporary  variable  for  unify  goals: 
unify_temp (V,  Perms,  x(8))  :-  in(V,  Perms),  I. 

uni fy_temp ( V,  Perms,  V). 


is  signaled. 
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%  Create  the  call: 

goal_call (Name,  Arity,  [Name/Arity I L) ,  L)  :- 
escape_builtin (Name, Arity) ,  !. 

goal_call (Name,  Arity,  [call (Name, _) IL] ,  L) . 

%  Code  for  second  argument  of  ' predicate: 
unify_2ndpart (W,  Temp,  [get (_, W, Temp) | Link ] -Link) 
var  (W)  ,  !  . 

unify_2ndpart (W,  Temp,  [get (constant, W, Temp)  I  Link] -Link)  :- 
atomic (W) ,  ! . 

unify_2ndpart (W,  Temp,  [get ( structure, /2, Temp) I L] -Link)  :- 
list (W) ,  ! , 

unifyblock  (list,  W,  L-Link) . 

unify_2ndpart (W,  Temp,  [get (structure, Name/Arity, Temp) I L] -Link)  :-  !, 

W= . . [Name  I Args] ,  my_length (Args,  Arity), 
unifyblock  (nonlist,  Args,  L-Link). 

%  Initialization  of  variables: 

%  Uses  register  8  as  a  holder, 
initblock ( [ ] ,  Link-Link). 

initblock ( [VI Vars] ,  [put (_, V, x  (8) )  I  Rest ] -Link)  :- 
initblock (Vars,  Rest-Link). 

%  Get  or  put  of  all  head  arguments: 

%  (If  Type  is  get  or  put)  . 

getputblock (Type,  [AtArgs],  [XIRest] -Link,  N)  :- 
X= .  .  [Type,  T,  A,  x  (N )  ] , 

(atomic (A)  ->  T=constant;  true), 

N 1  is  N  +  l, 

getputblock (Type,  Args,  Rest-Link,  Nl) . 
getputblock (_,  [],  Link-Link,  _) . 

%  Block  of  unify  instructions  to  unify  structures  or  lists: 
unifyblock (nonlist,  [],  [unify_nil I  Link] -Link) . 

unifyblock (list,  V,  (unify  (cdr,  x  (8)  )  ,  get  (_,.V,  x  (8)  )  I  Link] -Link)  :-  var(V) 
unifyblock (list,  [],  [unify_nil I  Link] -Link)  :-  !. 
unifyblock (Type,  [A  I Args],  (unify (T, A)  I  Rest ] -Link)  :- 
(atomic (A)  ->  T=constant;  true), 
unifyblock (Type,  Args,  Rest-Link). 

/**•****•**************•******••********»*•**********••***•************/ 

%  Adding  initialization  instructions 
%  in  disjunctions  to  variables  which  need  it. 

%  Result  is  a  modified  PartObj. 

%  Traverses  code  once;  passes  over  everything  without 
%  a  passing  glance  except  disjunctions. 

%  Must  be  used  before  tempalloc. 

varinit (Forward,  Backward,  Partobj,  Newobj)  :- 

xvarinit (Forward,  Backward,  Partobj,  Newobj-[]),  !. 

xvarinit ( [_] ,  _,  X,  R-L)  :-  linkify(X,  R-L) ,  !. 

%  The  first  two  clauses  traverse  Forward,  Backward,  and  Partobj 
%  until  a  disjunction  is  found: 

xvarinit([  ,FTr'F-r  — (_  Bln  I  Backward] ,  Partobj,  NewObj)  :  - 

(prolog_version (soprolog)  ->  not (FIn= <_•_)) ;  ' \+' (FIn= (_;_))) ,  ! 

%  Note:  since  Forward  and  Backward  have  identical 
%  structure,  only  one  must  be  tested. 

xvarinit ( [Fin IForward] ,  [Bln  I Backwa rd] ,  PartObj,  NewObj),  !. 
xvarinit (Forward,  Backward,  [GIPartObj],  [G I NewObj ] -Link)  :- 

(prolog_version (sbprolog)  ->  not (G= (_;_)) ;  ' \  +  '  (G=  (_;_))) ,  ! , 
xvarinit (Forward,  Backward,  Partobj,  NewObj-Link) ,  ! . 
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%  At  this  stage  ail  three  arguments  have  disjunctions: 
xvarinit ( [FLeft, (FA;FB) ,FRight IForward] , 

[BLeft,  (BA; BB) , BRight I  Backward ] , 

( (A; B) I PartOb j ] ,  [ (NA;NB) I NewOb j] -Link)  !, 

diffv (FRight,  FLeft,  T) , 
intersectv  (T,  BRight,  V).. 

dis_varinit (V,  (FA;FB) ,  (BA;BB! ,  (A;B) ,  (NA;NB) ) , 

xvarinit ( (FRight | Forward] ,  [BRight I  Backward] ,  PartObj,  NewObj-Link) ,  ! 

dis_varinit (V,  (FA;FB) ,  (BA;BB) ,  ( A;  B) ,  (NA; NB) )  :- 

one_choice  (V,  FA,  BA,  A,  NA)  , 
dis_varinit (V,  FB,  BB,  B,  NB) . 
dis_varinit (V,  FA,  BA,  A,  NA) 

one_choice (V,  FA,  BA,  A,  NA) . 

one_choice (V,  FA,  BA,  A,  NA)  :- 

xvarinit  (FA,  BA,  NA-Link)  , 
last (FA,  FLast) , 
diffv(V,  FLast,  InitVars) , 
add_init_list (InitVars,  Link)  . 

add_init_list ( [ ] ,  []) 

add_init_list (InitVars,  (Initlnstr))  init^list ( InitVars,  Initlnstr) 

init_list ( [ VI Vars] ,  [put ( variable, V, V)  I  Rest ] -Link) 
init_list (Vars,  Rest-Link). 
init_list  (  [ ] ,  Link-Link). 

/a*************-********************************************************/ 

%  Turn  parcial  object  code,  which  still  contains  the 
%  hierarchy  of  goals  and  disjunctions,  into  a  uniform  list. 

%  The  control  instructions  for  disjunctions  are  compiled  and 
%  the  labels  for  the  cut  instructions  are  instantiated, 
objcode (PartOb j,  ObjCode) 

xobjcode (PartObj,  ObjCode- (],  proc,  _) ,  !. 

xobjcode([],  Link-Link,  _,  _) . 

xobjcode ( [cutd I RestCode] ,  [cutd (CutLbl ) I C ] -Link,  CutLbl,  yes)  :- 
xobjcode (RestCode,  C-Link,  CutLbl,  _) . 
xobjcode ( [Code-L IRestCode] ,  Code-Link,  CutLbl,  IsCut)  :- 
xobjcode  (RestCode,  L-Link,  CutLbl,  IsCut). 
xobjcode ([ (X;Choices) IRestCode] ,  ( t ry (else, LI) I ChCode] -Link ,  CutLbl,  IsCut)  :- 

xobjcode (X,  ChCode-ChLink,  LI,  _) , 

ChLink* [execute (EndLbl) , label (LI) IC3 J , 
xdiscode  (Choices,  C3-L,  EndLbl), 
xobjcode (RestCode,  L-Link,  CutLbl,  IsCut). 

xdiscode ( (X;Choices) ,  [ retry (else, L2) I ChCode ] -Link,  EndLbl)  :- 

xobjcode(X,  ChCode-ChLink,  L2,  _) , 

ChLink= [execute (EndLbl) , label (L2) IC3] , 
xdiscode (Choices,  C3-Link,  EndLbl). 
xdiscode (LastChoice,  Code-Link,  EndLbl)  :- 

xobjcode  (LastChoice,  ChCode-ChLink,  CutLbl,  IsCut), 
lastchoice ( l3Cut , CutLbl, EndLbl , Code, ChCode, ChLink, L) , 

L*  [  label  (EndLbl)  I  Link]  . 

%  Handle  case  of  cut  in  last  choice: 

lastchoice ( IsCut , Cut Lb 1, EndLbl , Code, ChCode, ChLink, L)  : - 
IsCut==yes,  !, 

Code* ( ret ry  (else, CutLbl )  I ChCode ] , 

ChLink* (execute (EndLbl) , label(CutLbl) .trust (else, fail) , fail/OlL] . 
lastchoice (IsCut, CutLbl, EndLbl, Code, ChCode, ChLink, L)  : - 
Code* [trust (else, fail) IChCode] , 

ChLink=L . 

/A***#*****#****#**###**#*###***#*******#*****************#*****#****#*/ 
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%  Value-variable  annotation: 

%  Assumes  that  initializations  of  variables 
%  that  needed  it  have  been  added  to  the  code. 

%  Assumes  that  code  still  contains  disjunction  structure 


%  Pass  1: 
% 

% 

% 

% 

%  Pass  2: 
% 

% 

% 

% 


First  occurrences  of  all  variables  are 
marked  'variable'.  All  variables  occurring 
first  in  a  'put'  are  marked  unsafe.  Later, 
'excess'  will  only  allow  permanents  to  keep 
the  unsafe  annotation. 

Do  a  reverse  pass.  First  encounters  of 
unsafe  variables  are  marked  ' unsafe_value' , 
unless  they  are  already  marked  'variable'. 

All  other  encounters  with  variables  are  marked 
' value' . 


%  Must  be  done  before  temporary  variable  allocation  and 
%  after  calculation  of  permanent  variables. 


%  Variables  encountered  so  far  are  kept  in  the  set  SoFar 
%  in  both  passes.  This  set  is  passed  in  parallel  across 
%  disjunctions,  and  the  different  SoFar' s  are  united  upo 
%  exiting  disjunctions. 


%  Top  level: 

valvar  (PartObj,  HeadVars)  :- 

valvarl (PartOb j ,  [],  PossUnSafe,  [],  _)  ,  !, 

dif fv (PossUnSafe,  HeadVars,  UnSafe), 
valvar2  (PartOb j,  UnSafe,  [],  _) ,  !. 


%  Pass  1: 

valvarl (V,  UnSafe,  UnSafe, 

,  SF, 

SF)  :- 

(var(V);V-{))  . 

valvarl ([ (A;B) 1 RestCode], 

InUS, 

,  OutUS 

,  SoFar 

,  OutSF) 

disvalvarl ( (A;B)  , 

InUS, 

,  US1, 

SoFar, 

NewSF)  , 

valvarl (RestCode, 

US1, 

OutUS, 

NewSF, 

OutSF)  . 

valvarl ( (G-LIRestCode] ,  InUS,  OutUS,  SoFar,  OutSF)  :- 
valvarl (G,  InUS,  US1,  SoFar,  NewSF) , 
valvarl (RestCode,  US1,  OutUS,  NewSF,  OutSF). 
valvarl ([ I ! Rest Instr] ,  InUS,  OutUS,  SoFar,  OutSF)  :- 
typeargd,  T,  X),  !, 

(notin  (X,  SoFar)  ,  Invariable;  true), 
new_us(I,  X,  SoFar,  InUS,  US1), 
unionv((X],  SoFar,  NewSF), 

valvarl  (Rest Instr ,  US1,  OutUS,  NewSF,  OutSF). 
valvarl ( (_ I  Rest  Inst r] ,  InUS,  OutUS,  SoFar,  OutSF)  :- 

valvarl  (Rest Instr,  InUS,  OutUS,  SoFar,  OutSF). 

new_us(I,  X,  SoFar,  InUS,  US1)  :- 

I=put  (_,_,_)  ,  notin(X,  SoFar),  !, 
unionv((X],  InUS,  US1)  . 
new_us(I,  X,  SoFar,  InUS,  InUS). 


disvalvarl ( (A;B) ,  InUS,  OutUS,  SoFar,  OutSF)  :- 
valvarl (A,  InUS,  US1,  SoFar,  Outl), 


disvalvarl (B,  US1 

,  OutUS, 

SoFar, 

Out2) , 

unionvIOutl,  0ut2 

,  OutSF) 

disvalvarl (B,  InUS,  OutUS 

,  SoFar, 

OutSF) 

valvarl (B,  InUS, 

OutUS,  SoFar,  OutSF) . 

%  Pass  2: 

valvar2(V,  _,  SF,  SF)  :- 

(var(V)  ; 

V- ( ] )  . 

valvar 2 ( 1 (A;B) 1 RestCode ] , 

UnSafe, 

SoFar, 

OutSF)  : - 

valvar2  (RestCode, 

UnSafe, 

SoFar, 

NewSF) , 

disvalvar2 ( (A;B) , 

UnSa  fe. 

NewSF, 

OutSF) . 

val var2 ( [G-LI RestCode] ,  Unsafe,  SoFar,  OutSF)  :- 

val var2 (RestCode, 

UnSafe, 

SoFar, 

NewSF) , 

valvar2(G,  UnSafe 

,  NewSF, 

OutSF) 
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valvar2 ( [ 1 1  Rest Instr ] ,  Unsafe,  SoFar,  OutSF) 
type_arg(I,  T,  X),  !, 

valvar2  (Restlnstr,  Unsafe,  SoFar,  NewSF), 
choose_annotat ion  (X,  UnSafe,  NewSF,  T) , 
unionv([X],  NewSF,  OutSF). 
valvar2 ([_ I Restlnstr ] ,  UnSafe,  SoFar,  OutSF) 

valvar2 (Restlnstr,  UnSafe,  SoFar,  OutSF). 

choose_annotation (X,  UnSafe,  NewSF,  T) 

in (X,  Unsafe),  notin (X,  NewSF),  !, 
make_unsafe_value (T) . 
choose_annotat ion (X,  UnSafe,  NewSF,  T) 
make_value (T) . 

disvalvar2 ( (A;B) ,  Unsafe,  SoFar,  OutSF)  :- 
valvar2(A,  UnSafe,  SoFar,  Outl)  , 
disvalvar2 (B,  Unsafe,  SoFar,  0ut2) , 
unionv(Outl,  Out2,  OutSF). 
disvalvar2 (B,  Unsafe,  SoFar,  OutSF) 

valvar2(B,  UnSafe,  SoFar,  OutSF)  . 

%  Make  unsafe_value  if  possible 
make_unsafe_value (unsafe_value)  ! . 
make_unsafe_value (_)  !. 

%  Make  value  if  possible 
make_value (value)  !. 
makevalue (_)  !. 

/**1r**»t***t****t*iMt#**i)»*1t»*****»**»*»*«***w,*«t***1rilK*t*«********lr***^ 

%  Find  all  permanent  variables 
permvars ( [Head  I  Body ] ,  Vars,  Perms) 
colvars (Head,  HeadVars), 

xpermvars (Body,  [HeadVars,  (),[)) ,  [Vars, Hal f, Perms ]) ,  !. 

xpermvars ( [ ] ,  AllVars,  AllVars) . 

%  Disjunction: 

xpermvars ( [Dis I  Rest ] ,  SoFar,  Out)  :- 
Dis*  <_,-_),  ! , 

disxpermvars  (Dis,  SoFar,  NewSoFar) , 
xpermvars (Rest,  NewSoFar,  Out). 

%  Conjunction: 

xpermvars ( [AIRest] ,  SoFar,  Out)  :- 
SoFar=[Vars,  Half,  Perms), 
colvars (A,  Avars), 
intersectv (AVars,  Half,  P), 

unionv  (Perms,  P,  NewPerms) ,  %  Fresh  variables  at  end  of  NewPerms. 
unionv (AVars,  Vars,  NewVars) , 
newhalf(A,  Half,  NewVars,  NewHalf), 

NewSoFar* (NewVars,  NewHalf,  NewPerms], 
xpermvars  (Rest ,  NewSoFar,  Out). 

%  calculate  new  Half  permanent  set: 
newhalf(A,  Half,  NewVars,  Half)  :- 
escape_builtin (A) ,  !. 

newhalf(A,  Half,  NewVars,  NewHalf)  :- 

un  ionv  (NewVars,  Half,  NewHalf). 

disxpermvars ( (A;B) ,  SoFar,  Out)  !, 
xpermvars (A,  SoFar,  OutA) , 
disxpermvars (B,  SoFar,  OutB) , 

mapcar  (unionv,  OutA,  OutB,  Out)  .  4  Fresh  vars  at  end  of  Perms, 
disxpermvars  (B,  SoFar,  Out)  :- 

xpermvars  (B,  SoFar,  Out). 

/**•********•**#**********************«**««**«>****».*****«********„*****/ 
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%  Trivial  permalloc 

%  Variables  at  end  of  list  are  numbered  lowest. 

permalloc (PermVars)  :- 

permalloc  (PermVars,  _)  . 

permalloc ( [y (I) I Vars] ,  I)  :- 
permalloc (Vars,  ID, 

I  is  11+1  . 
permalloc ( []  ,  0)  . 

/*****»***********»*****«***»»»«****»«*****»«*»**************«*********/ 

%  Calculate  from  the  unraveled  source  code 
%  the  varlist  used  for  calculating  lifetimes. 

%  All  goal  arguments  (variables  &  atoms)  are  simply  listed. 

%  For  unify  goals  only  the  variables  are  listed. 

%  Goal  arguments  are  delimited  by  one  or  both  of  arity(Arity)  and  fence (Name) . 
%  This  is  determined  as  follows: 

%  1.  arity(Arity)  allows  tempalloc  to  do  more  optimal  allocation. 

%  It  comes  before  the  arguments. 

%  It  is  generated  for  all  gcals,  even  built-ins  (except  unify, 

%  or  goals  with  arity  zero) . 

%  2.  fence(Mame)  is  used  in  lifetime  to  kill  temporaries. 

%  It  comes  after  the  arguments. 

%  It  is  not  generated  for  built-ins  or  the  head  of  the  clause. 

% 

%  11/15/84  : 

%  Correction  -  last  line  of  item  1  used  to  be: 

% 

%  or  goals  with  arity  zero,  or  if  all  arguments  are  nonvariable)  . 

% 

%  This  is  incorrect  because  even  nonvariable  arguments  will  use  registers, 

%  so  tempalloc  will  have  to  be  made  aware  of  them. 

%  Fourth  line  of  goalsvars  used  to  be 
%  ( (Arity=0;getvars (Args,  (]-(]))  ->  Vars=L; 

varlist ( [Head  I RestCode] ,  (arity (Arity)  I Vars] )  :- 

Head=. . (Name  I Args] , 
my_length (Args,  Arity), 

1 inkif y (Args,  Vars-L) , 
xvarlist  (RestCode,  L-  1  ] ) ,  !. 

xvarlist  ( (X  I RestCode] ,  [Dis I Vars ) -Link)  :- 

x=  (_;_) , 

dislist  (X,  Dis) , 
xvarl ist  (RestCode,  Vars-Link) . 
xvarlist ( [Goal IRestCode] ,  Vars-Link)  :- 
goalsvars (Goal,  Vars-L), 
xvarlist (RestCode,  L-Link) . 
xvarlist ([],  Link-Link). 

disl ist ( (A;B) ,  (AVars; BVars) )  :- 

xvarlist (A,  AVars-[]), 
dislist  (B,  BVars). 
dislist  (B,  BVars)  :- 

xvarlist (B,  BVars-(J). 

goalsvars (A=S,  Vars_Link)  :- 
var(S),  !, 

getvars  ( [A, S] ,  Vars_Link)  . 
goalsvars (A=S,  Vars_Link)  :- 
list(S),  ! , 

getvars ( ( A I S] ,  Vars_Link)  . 
goalsvars (A=S,  Vars_Link)  :- 
atom (S) ,  ! , 

getvars  ((A),  Vars_Link) . 
goa lsvars ( A=S,  Vars_Link)  :- 
S= . . [_ I SVars ] , 

get  vars  (  ( A I  SVars ) ,  Vars_Link). 
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goalsvars (Goal,  Link-Link) 

atom(Goal),  escape_builtin  (Goal, 0) ,  !. 

goalsvars (Goal ,  [fence (Name) ILink]-Link'  :- 
atom(Goal)  ,  !  . 

goalsvars  (Goal,  [arity (Ar ity)  I V] -Link)  :- 
Goal= . . [Name  I Args] , 
my_length (Args, Arity) , 
escape_builtin (Name, Arity) ,  !, 

linkify (Args,  V-Link)  . 
goalsvars (Goal,  [arity (Arity)  I V] -Link)  :- 
Goal=. . (Name  I Args) , 
my_length (Args, Arity) , 
linkify  (Args,  V- [ fence (Name)  (Link))  . 

/***»«*«*******»«*«****«•*****«■*»»*********»»■»*»»»***»»****»**********«*/ 

%  Calculate  lifetimes  of  all  temporary 
%  variables  using  the  varlist. 

%  (Permanents  must  be  allocated  beforehand) 

%  Uses  fence (_)  to  forget  temporaries. 

%  Two  passes  needed:  Down  &  back  up. 

%  Lots  of  verbose  superfluous  code  used. 

lifetime (VarList,  LifeList,  ForwList,  BackList)  :- 
ForwList= [ [ ] I _] , 
forward (VarList,  ForwList,  _) , 
backward (VarList,  BackList,  []), 

mapclause (intersect v,  ForwList,  BackList,  LifeList),  !. 


%  Forward  Pass: 

%  Watch  out  for  data  flow! 

%  FLast  is  an  output,  FLeft  is  given, 
f orward ( [X (Rest J ,  [FLeft, FRight I FRest J ,  FLast)  :- 
var(X),  !, 

unionvUX],  FLeft,  FRight), 
forward  (Rest,  [FRight I FRest ] ,  FLast). 
forward (( fence (_)  I  Rest ] ,  [_,  [ ]  I FRest 1 ,  FLast)  :- 

forward  (Rest,  [[JIFRest],  FLast). 
forward ( [Dis I  Rest ] ,  [FLeft, Fin, FRight I FRest ] ,  FLast)  :- 
Dis= (_;_) , 

forwdis(Dis,  (FLeft, Fin],  FRight), 
forward  (Rest,  (FRight  I  FRest ] ,  FLast). 
forward ([_ I  Rest ] ,  [FLeft, FLeft IFRest ] ,  FLast)  :- 
forward  (Rest ,  [FLeft  I  FRest  ] ,  FLast). 
forward!  (],  [FLast],  FLast). 

%  Given :  FLeft . 

%  To  be  calculated:  Ain, Bln, FRight . 
forwdis ( (A;B) ,  [FLeft, (AIn;BIn) ] ,  FRight)  :- 
AIn=  [FLeft  l_]  , 
forward (A,  Ain,  ARight), 
forwdis  (B,  [FLeft, Bln],  BRight) , 
unionv (ARight,  BRight,  FRight). 
forwdisIB.  [FLeft, Bln],  FRight)  :- 

BIn= (FLeft I _ ] , 

forward(B,  Bln,  FRight). 


%  Backward  Pass: 

%  Watch  out  for  convoluted  data  flow! 

%  BLast  is  an  input,  others  (BLeft,  BRight)  are  outputs, 
backward (  |  X  I  Rest ] ,  ( BLe f t , BRight I BRest ] ,  BLast)  :- 

var(X),  ! , 

backward (Rest,  BRight I BRest ] ,  BLast), 
unionv([X],  BRicht,  BLeft). 
backward ( ( fence (_)  I  Rest ] ,  ( ( ] , L I BRest ] ,  BLast)  :- 

backward(Rest,  fLIBRest],  BLast). 
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backward ( (Dis I  Rest ] ,  (BLeft , Bln, BRighc t BRest 1 ,  BLast)  :- 
Dis= , 

backward (Rest ,  [BRight IBRest] ,  BLast), 
backdis(Dis,  (BLeft ,  Bln,  BRight  1 )  . 
backward ((_ IRest] ,  (BLeft , BLeft I BRest ) ,  BLast) 
backward  (Rest,  (BLeft  I  BRest  ] ,  BLast). 
backward([],  [BLast],  BLast). 

%  Given:  BRight. 

I  To  be  calculated:  XIn, Yin, BLeft . 
backdis ( (X;Y) ,  [BLeft, (XIn; Yin) , BRight ] )  :- 
XIn= [XLeft l_], 
backward(X,  XIn,  BRight), 
backdis(Y,  [YLeft,  Yin,  BRight] )  , 
unionv  (XLeft ,  YLeft ,  BLeft )  . 
backdis(Y,  [BLeft, Yin, BRight ] )  :- 

YIn= [BLeft I _! , 
backwardlY,  Yin,  BRight). 

%  A  new  &  possibly  correct  temporary  allocation  routine: 

%  Uses  the  variable  list  created  by  varlist 
%  and  the  lifetime  list  created  by  lifetime. 

%  Takes  the  overlap  of  registers  caused  by  calls  into  account. 

%  The  Life  list  does  not  have  to  contain  any  instantiated  entries. 

%  Optimization  -  11/16/84: 

%  Modified  tempa  so  that  it  will  identify  temporaries  which  are  not 
%  arguments  in  the  head  and  aren't 

%  arguments  of  a  call,  by  allocating  them  outside  of  the  registers  being 
%  currently  used  for  arguments,  thereby  leaving  them  available  for  other 
%  allocation.  This  allows  a  more  efficient  allocation  and  solves  the 
%  'determinate  concat'  optimization. 

%  Optimization  -  12/4/84: 

%  Modified  tempa  so  that  if  a  variable  first  occurs  between  the  head  and  the 
%  first  clause,  it  will  attempt  to  allocate  into  the  next  call's  argument 
%  registers.  Modification  done  at  statement  (1)  below. 

%  Similar  modification  can  probably  be  done  for  calls  after  first  call. 

%  bug  fix  -  3/21/86: 

%  cut  inserted  in  alloc  procedure  so  that  retract  will  succeed  only  once. 

%  This  was  not  a  problem  in  1.2,  where  retract  only  succeeded  once, 

%  no  matter  how  many  unifiable  clauses  were  available. 

%  Peter's  algorithm  took  advantage  of  this  bug. 

%  This  bug  doesn't  exist  in  1.5. 

%  In  order  to  simulate  the  bug,  the  cut  has  beer,  inserted. 

%  bug  fix  -  1/15/81: 

%  alloc/3  fixed.  Old  version  would  generate  a  choice  point  for  each  recursive 
%  call,  whereas  correct  version  generates  only  one  choice  point  per  allocation. 
%  This  bug  sometimes  led  to  an  enormous  increase  in  allocation  time. 

tempal loc ( (ar ity (HeadAr ity) I Vars J ,  [  ILife])  :- 

abolish (cause,  1), 
assert (cause (none) ) , 

tempa (Vars,  Life,  1,  HeadArity,  [),  head),  !. 


%  Fail  if  there  is  a  conflict: 

tempa(Vars,  [LivelRJ,  N,  Arity,  OK,  Place!  :- 

conf lict_interva 1 (P lace,  N,  Arity,  Interval), 

conflict  (Li ve.  Interval,  I), 

not  in ( I, OK) , 

abolish (cause,  1), 

assert (cause  (I) ) , 

! ,  fail. 
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tempa  ([],  _,  _) 

%  Try  to  allocate  co  an  argument: 

cempa ( [X  I Vars ] ,  [ Lef t , Right  I  Li feList ] ,  N,  Arity,  CK,  Place)  :~ 

var(X),  in (X,  Right),  !, 

alloc_start_reg 'Place,  X,  Vars,  N,  Arity,  StartReg) , 
alloc (X,  Right,  StartReg), 

update_params (X,  N,  Arity,  OK,  NewN,  NewArity,  NewOK) , 
tempa(Vars,  [Right  I  Li feLi st ] ,  NewN,  NewArity,  NewOK,  Place). 

%  failure  of  tempa  backtracks  to  alloc 
%  which  redoes  the  allocation  causing  the  conflict, 
tempa ( [X I Vars ] ,  [_ I LifeList ] ,  _,  _,  _,  Place) 

nonvar(X),  X=arity (Arity) ,  !, 

tempa (Vars,  LifeList,  1,  Arity,  [],  body)  . 
tempa ( [X  I Vars ] ,  [ Left , In, Right  I  Li feLi st ] ,  _,  _,  _,  Place) 

nonvar(X),  X=  (_;_),  In=  (_;_),  ), 

distempa (X,  In) , 

tempa(Vars,  (Right ] Li feList ] ,  1,  0,  [),  body), 

tempa ( (X  I Vars] ,  (_ I LifeList ] ,  N,  Arity,  OK,  Place)  :~ 

update_params (X,  N,  Arity,  OK,  NewN,  NewArity,  NewOK), 
tempa (Vars,  LifeList,  NewN,  NewArity,  NewOK,  Place)  . 

%  Handle  disjunctions: 

distempa ( (A;B) ,  ( ALi fe ; BLife ) )  :-  !,  %  cut  needed  for  correct  conflict  detect 

tempa (A,  ALife,  1,  0,  [],  body), 

distempa(B,  BLife). 
distempa(B,  BLife)  :- 

tempa  (B,  BLife,  1,  0,  [],  body). 

%  Calculate  conflict  interval. 

%  Depends  on  place  in  a  call  sequence 
conf lict_intei val (body,  1,  _,  empty)  :-  !. 
conf  lict_interval  (body,  N,  _,  int(l,Nl))  :-  !,  N1  is  N-l  . 
conflict_interval (head,  N,  Arity,  empty)  :-  NsArity,  !. 
conf 1 ict_interval (head,  N,  Arity,  int <N, Arity) )  :-  !. 

%  Update  parameters  of  tempa. 

update__params  (X,  N,  Arity,  OK,  NewN,  NewArity,  NewOK)  :- 
N=<Arity,  !, 

NewN  is  N+l, 

NewArity= Arity, 
newok  (X,  N,  OK,  NewOK). 
update_params (_,  1,  0,  (]) 

%  New  value  of  OK  list 
newok (X,  N,  OK,  [N I  OK] )  :- 

nonvar(X),  X=x(N),  !. 

newok (X,  N,  OK,  OK)  :-  !. 

%  Calculate  register  to  start  allocation  with. 

%  If  in  head,  avoid  using  arg.  reg.  of  next  caii 
alloc_start_reg (head,  X,  Vars,  N,  Arity,  StartReg)  :- 
N>Arity,  not  innextcal  1  (X,  Vars,  NextArity),  , 

StartReg  is  NextArity+1  . 

ailoc_start_reg (head,  _,  N,  Arity,  StartReg)  :- 
N  =  <Arity,  !, 

StartReg  =  N. 

%  Default  starting  value  is  register  1 
a  1 loc_st art_reg (head,  _,  _,  _,  _,  i) 

a Iloc_start_reg (body,  _,  _,  N,  _,  N)  : -  !. 

%  Succeeds  iff  there  is  a  register  conflict: 

%  The  ''nterval  (L,  L  +  l,  ...,  Hj  is  also  considered  as  live  registers. 

%  It  is  represented  as  int(L,H)  or  as  the  atom  'empty', 
conf 1 ict (Li ve,  int(L,H),  I)  :- 
L=<H. 

range  (L,  I,  H)  , 
in (x  ( I )  ,  Live). 


plm_compiler • 29 


plm_compiler 


conf 1 ict ( Live,  R,  I)  :- 

conflict  (Live,  I)  . 

conf 1 ict ( [ V ( Li ve ] ,  I) 

nonvar  (V)  ,  V=x  ( I)  , 
in (V,  Live)  . 
conf 1 ict ( [ R I  Li ve] ,  I) 

conflict (Live,  I). 

%  Allocate  a  register. 

%  When  there  is  a  conflict, 

%  supports  sophisticated  backtracking  to  the  cause. 

%  Don't  allocate  X8 . 

%  Bug  fix  Jan.  15:  every  recursive  call  generated  a  choice  point, 
%  whereas  only  one  choice  point  per  allocation  mey  be  generated. 
ailoc(X,  Alive,  N) 

(prolog_version (sbprolog)  ->  noc(N=8);  \+(N=8)), 
notin (x (N) , Alive  ,  X=x(N). 
alloc(X,  Alive,  N) 

cause(none),  !,  4  <-  Bug  fix:  this  cut  is  essential. 

Nl  is  N+l, 

alloc(X,  Alive,  Nl) . 
alloc(X,  Alive,  N)  :- 

cause  (N),  abolish  (cause,  1),  assert (cause (none) ) , 

Nl  is  N+l, 

alloc (X,  Alive,  Nl) . 

%  Find  next  call  and  return  arity. 

%  Fails  if  no  next  call  or  if  X  is  not  an  argument  of  it. 
not i nnext call (X, Vars, Next Arity)  :  - 

is next call (Vars, Call, NextArity)  ,  ! , 
notin  (X,  Call)  . 

isnextcall ( (V  I  Rest Vars] , Rest Vars, Next Arity)  :  - 
nonvar  (V)  , 

V  =  arity (NextArity) ,! . 
isnextcall ( [_ I  Rest Vars] , Call, Next Arity)  :- 

isnextcall (Rest Vars, Call, NextArity) . 


%  Fix  code  containing  illegal  (excess)  temporary  variables, 
%  those  temporaries  numbered  X9  or  higher. 


% 

% 

% 

% 

% 

% 

% 

I 

% 


Excess  phase  contains  three  passes: 

1.  Backwards  pass  to  reallocate  permanents  and  excess  temporaries 
as  permanents.  As  in  permalloc,  variables  whose  last  use 

is  later  in  the  program  get  lower  numbered  locations. 

2.  Forward  pass  to  fix  up  all  get  and  put  instructions  whose 
second  operand  is  now  a  permanent. 

3.  Forward  pass  to  change  the  ’ unsafe_value'  annotation  to  a 
'value'  annotation  for  all  temporaries.  This  finishes  the 
work  started  by  valvar. 


excess (Ob jcode, Ob jcode4 )  :- 

excess (Ob jcode,  Ob jcode 2 , _) , 
cleanup (Ob jcode2, Ob jcode3) , 
temp_va lue (Ob jcodel, Ob jcode4 )  . 

%  Pass  1 . 


excess ( 1 1 i Rest  j ,  [Nl  I  NR] , NewPerm, NewMap)  :  - 
excess (Rest , NR, Next Perm, Map)  , 

f ix  excess ( I , Nl , Next Perm, NewPerm, Map, NewMap!  . 
excess  ([},!],!,(]). 
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f ixexcess (get (Ann , A, 8) , get ( Ann, NA, NB) , Next Perm, NewPerm, Map, NewMap)  : - 
f ix_temp (A, NA, NextPerm, NextPerm2,  Map,  NextMap)  , 
f ix_temp (B, NB, NextPerm2 , NewPerm, NextMap,  NewMap)  . 

f ix_excess (put (Ann, A, B) , put (Ann, NA, NB) , NextPerm, NewPerm, Map, NewMap)  : - 
f ix_temp (A, NA, NextPerm, NextPerm2, Map, NextMap) , 
f ix_temp (B, NB, NextPerm2 , NewPerm, NextMap, NewMap) . 

f ix_excess (unify (Ann, A) .unify (Ann, NA) , NextPerm, NewPerm, Map, NewMap)  : - 
f ix_temp (A, NA, NextPerm, NewPerm, Map, NewMap) . 

f ix_excess (1,1, NextPerm, NextPerm, Map, Map) . 

%  allocate  a  new  permanent  in  place  of  old  permanent  or  excess  temporary. 

f ix_temp (A, NA, NextPerm, NewPerm, Map, NewMap)  : - 
nonvar(A),  A=x(I),  I>8,  !, 

add_perm (A, NA, NextPerm, NewPerm,  Map,  NewMap)  . 

f ix_temp (A, NA, NextPerm, NewPerm, Map, NewMap)  : - 
nonvar(A),  A=y(_),  !, 

add_perm (A, NA, NextPerm, NewPerm, Map, NewMap) . 

f ix_temp (A, A, NextPerm, NextPerm,  Map,  Map)  . 

add_perm (A, NA, NextPerm, NewPerm, Map, NewMap) 
inmap  (A,  Map,  NA) ,  !, 

NewMap  =  Map,  NewPerm  =  NextPerm. 
add_perm (A, NA, NextPerm, NewPerm, Map,  NewMap) 

NA  =  y  (NextPerm), 

NewPerm  is  NextPerm+1, 

NewMap  »  (pair (A, NA)  I  Map] . 

%  check  whether  variable  has  been  reallocated  yet, 

%  and  it  so,  what  it  has  been  reallocated  to. 

inmap (A, [pair ( A, NA) I _] , NA)  !. 

inmap (A,  [_ I  Rest ] , NA)  inmap (A, Rest, NA) ,  !. 

%  Pass  2. 

cleanup ( (put (Ann, A, B) , get  (st ructure, S, C)  I  Rest ] , 

(put  (Ann,  A,  x  (8)  )  ,  get  (structure,  S,  x  (8!  )  !  NRest  i )  :  - 

nonvar (A) ,  nonvar(B),  nonvar(C),  A  =  y ( _ ) ,  A  =  B,  B  =  C,  !, 

cleanup (Rest , NRest)  . 

cleanup ( (put (Ann, A, B)  IRest], 

(put (value, B, x (8) ) , put  (structure, A, x  (8) )  I NRest  J )  :  - 
nonvar (Ann),  Ann  =  structure,  nonvar (B),  B  =  y{_),  !, 

cleanup (Rest , NRest)  . 

cleanup ( (put (Ann, A, B)  IRest], 

[put (Ann, A, x  (8) ) , get (variable,B,x(8))  I NRest ] ) 

nonvar (B) ,  B  =  y  < _ ) ,  !, 

cleanup (Rest , NRest )  . 

cleanup ( [get (Ann, A, B) IRest], 

[put  (value,  B,  x  (8)  ),  get  (Ann,  A,  x  (8)  )  I  NRest ) )  :  - 
nonvar  (B)  ,  B  =  y(  ),  !, 

cleanup (Rest , NRest ) . 

cleanup (( I  I  Rest ] ,  [II NRest  J )  cleanup  (Rest , NRest ) . 

cleanup!  [],[])  . 
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%  Pass  3. 

temp_value (  [I  I  Rest J ,  [NIINRest]) 

1= . . [N, unsafe_value, X  I RI] , 
nonvar  (XI  ,  X=x(_),  !, 

NI=. . [N, value, XIRI] , 
temp_value (Rest,  NRest). 
temp_value  (  [I  I  Rest ] ,  [IINRest]) 
temp_value  (Rest ,  NRest). 
temp_value ( [ ] ,  ( ] )  . 


/Hr***************************  ***************  *******  ****************/ 

%  Calculate  environment  sizes  in  all  call  instructions: 

%  Returns  maximum  environment  size. 


envsize 

envsize 

envsize 


envsize 


([],  0)  !. 

(  (call (_, EnvSize)  ICode] 
envsize (Code,  EnvSize) 
([II  Code] ,  EnvSize) 
type_arg(I,  T,  R)  , 
nonvar  (R),  R=y(Nl), 
envsize (Code,  N2), 
max(Nl,  N2,  EnvSize), 
([__|Code],  EnvSize)  :- 
envsize (Code,  EnvSize) 


EnvSize) 


/***«*****»***********#****«***  ********  ***************************  ******/ 

%  Take  care  of  void  variables: 

%  (1)  Remove  gets 

%  (2)  Instantiate  unallocated  variables 

%  (3)  Collect  unifys 

%  Bug  fix  Jan.  15,  1981:  old  version  left  some  unallocated 
%  voids  uninstantiated.  Two  fixes  were  considered: 

%  source  code  transformation  &  simple  use  of  x(8). 

%  For  simplicity  the  latter  was  done  here. 

%  Remove  superfluous  gets  of  voids: 
voidalloc ( [get (_, A, _) ICode] ,  VCode)  :- 
var (A) ,  ! , 

voidalloc (Code,  VCode). 


%  Collect  unifies  of  voids  and  replace  by  unify_void  N: 
voidalloc  (Code,  [unify (void, N)  I VCode] )  :- 

collect_voids (Code,  Rest,  N) ,  N>0,  !, 

voidalloc (Rest,  VCode). 

%  Instantiate  puts  of  voids  to  registers: 
voidalloc ( [XlCode] ,  [XIVCode])  :- 
inst_void (X) ,  ! , 

voidal loc (Code,  VCode)  . 

%  Default  clause: 

voidal loc ([ I | Code] ,  [I (VCode])  :-  !, 
voidalloc (Code,  VCode) . 
voidalloc ( [ ]  ,  [ ] )  . 


col lect_voids ( (uni fy (_, Arg) ICode ] ,  Rest,  N)  :- 
var(Arg),  ! , 

collect_voids (Code,  Rest,  Nl), 

N  is  Nl+1  . 

collect_voids (Code,  Rest,  0)  :-  Rest=Code. 

\  Bug  fix  Jan.  15:  added  this  predicate. 

%  Instantiate  variables  left  unallocated  to  x(8): 
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inst_void (unify (cdr, x (8) ) )  !. 

inst_void (put (variable, x  (8) ,  x  (8) ) )  !. 

inst_void (put (variable,  R,  R)  )  !. 

inst_void (get (structure, x (8) ) )  !. 

inst_void (put (structure, x (8) ) )  !. 

/*««*«*«*««*»»*«*»•***«********»**»**«***«»*****«***««»»****•**»*•»****/ 

%  eliminate  redundant  assignments 
%  We  can  remove  a  put_vaiue  Yj,Xi  when: 

%  1)  it's  before  the  first  call,  and 

%  2)  Yj  was  initialized  by  a  get_variable,  and 

%  3)  between  the  get_variable  and  the  put_value,  there's  no  get,  put,  or 

%  unify  instruction  which  references  Xi.  (This  is  probably  overkill, 

%  but  it  is  correct.) 

%  The  purpose  of  this  optimization  is  to  fix  code  for  clauses  like: 

%  a  (X)  :  -  b  (X) ,  x  (X)  . 

%  which  generates: 

%  get_variable  Y1,X1 

%  put_value  Y1,X1  <  redundant  instruction  > 

%  call  b/1 

%  —  Wayne  (1/28) 

assn_elim  (Code,  ACode)  :- 

assn_elim (Code,  ACode, live (no, no, no, no, no, no, no) )  . 

assn_elim ( [ 1 1  Rest ) ,  [I!Rest],_)  :- 

I  =  call  (_,_),!. 
assn_elim ( [ ] ,  (],  _)  :-  !. 

assn_elim ( (get (variable, Y, R)  I  Rest ] , 

[get (variable, Y, R) INewRest], 

Live)  :- 
nonvar  (Y)  , 

Y=y (J) , 

R=x(I),  I\-=8,  !, 
make_l ive (Live, I, J, NewLive) , 
assn_elim (Rest, NewRest , NewLive) . 
assn_elim ( (put (value, Y, R)  I  Rest ] , 

NewRest, 

Live)  :- 

nonvar(Y),  Y=y(J),  R=x(I),  is_l  ive  (Live,  I,  J)  ,  !, 

assn_elim(Rest, NewRest , Live) . 
assn_elim  (  [ 1 1  Rest ) ,  [IlNewRest],  Live)  :- 

(I=put (A, X, Y) ;  I=get ( A, X, Y) ;  I=unif y (A, X) ) , 

(nonvar  (X),  X=x(K)  ->  make_dead (Live, K, NewLive)  ;  NewLive  -  Live), 
(nonvar  (Y),  Y=x(J)  ->  make_dead (NewLive, J, NewLive2) ; 
NewLive2=NewLive) , ! , 
assn_el im (Rest , NewRest , NewLi ve2 ) . 
assn_elim ( ( 1 1  Rest ] ,  (IlNewRest),  Live) 
assne 1 im (Rest , NewRest , Li ve ) . 

%  Live  structure  has  exactly  seven  elements. 
make_live  ( 1  i ve  ( A1 ,  A2 ,  A3 ,  A  4 ,  AS,  A6,  A7 )  ,  1 ,  J, 
live  ( J,  A2,  A3,  A4 ,  AS,  A6,  A7 )  )  . 

make_iive ( 1 ive ( Al, A2 , A3 , A  4 , A5, A6, A7 ) , 2 , J, 
live  (Al,  J,  A3,  A4,  A5,  A6,  A7)  )  . 

make_l ive ( 1 ive ( Al,  A2 , A3, A4 , A5 , A6, Al ) , 3 , J, 

1  ive  ( Al ,  A2 ,  J,  A4 ,  AS ,  A6,  A7 )  )  . 

make_l  ive  ( live  (Al,  A2,  A3,  A4,  A5,  A6,  A7)  ,  4,  J, 

1  ive  (Al,  A2,  A3,  J,  A5,  A6,  A7)  )  . 

make_l ive ( 1 ive ( Al , A2, A3 , A4 , A5, A6, A7 ) , 5 , J, 
live(Al,A2,A3,A4,J,A6,A7)  )  . 

make_live  ( 1  i  ve  (Al,  A2,  A3 ,  A4,  A5,  A6,  A7)  ,  6,  J, 
livefAl,  A2,A3,A4,A5,  J,A7)  )  . 
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make_live  (live  ( Al,  A2 ,  A3,  A  4 ,  A5,  A6,  A  7 )  ,  7 ,  J, 
live(Al,A2,A3,A4,A5,  A6,  J)  )  . 

make_dead  ( 1  ive  ( Al,  A2,  A3,  A  4 ,  A5,  A6,  A  7 )  ,1, 

1  i ve  (no,  A2,  A3,  A4,  A5,  A6,  A7)  )  . 

make_dead (live ( Al, A2 , A3, A  4 , A5 , A6, A7 ) ,2, 
li ve  (Al,  no,  A3,  A4,  A5,  A6,  A7 ) )  . 

make_dead  ( live  (Al,  A2,  A3,  A4,  AS,  A6,  A7)  ,3, 

1  ive  (Al,  A2,  no,  A4,  A5,  A6,  A7) )  . 

make_dead (live (Al, A2 , A3 , A4 , A5, A6, A7 ) , 4 , 
live  (Al,  A2,  A3,  no,  AS,  A6,  A7) )  . 

make_dead ( live (Al, A2 , A3 , A4 , AS , A6,  A7 ) , 5 , 
live (Al,  A2, A3, A4 , no, A6,  A7) )  . 

make_dead ( 1 ive ( Al, A2 , A3, A4 , A5 , A6, A7 ) ,6, 

1  ive  (Al,  A2,  A3,  A4,  A5,  no,  A7) )  . 

make_dead  (live(Al,A2,A3,A4,A5,A6,A7),7, 
live  (Al,  A2,  A3,  A4,  A5,  A6,  no) )  . 

is  live (Live, I, J)  arg ( X, Live, J)  . 


*-****#*iir*** 
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%  Do  peephole  optimization  of  several  kinds: 

%  (1)  many  special  instruction  sequences. 

%  (2)  code  generation  for  some  built-ins. 

%  (3)  allocate  i  deallocate  instructions. 

%  (4)  last  instruction  (proceed  or  execute). 

%  (5)  customization  of  instructions. 

peephole (Code,  PCode,  Link,  MaxSize) 

peephole (Code,  PCode,  Link,  nc_alloc,  MaxSize,  no_dummy) ,  !. 

%  The  call/1  predicate  must  be  an  escape: 

peephole ( (call  (call/1, _)  ICode] ,  PCode,  Link,  Alloc,  M,  D)  :-  !, 
peephole ( (call/1 ICode) ,  PCode,  Link,  Alloc,  M,  D) . 

%  Insert  the  allocate  and  deallocate  instructions 

%  and  take  care  of  the  last  instruction. 

peephole  (  (call  (G,  0)  ] ,  LastCode,  Link,  Alloc,  M,  D) 

lastcode (Al loc,  LastCode,  [execute (G)  I  Link) ) . 

peephole  ([],  LastCode,  Link,  Alloc,  M,  D)  :-  !, 

lastcode (Alloc,  LastCode,  [proceed  I  Link ])  . 

%  Insert  the  correct  allocate  instruction: 

peephole ([ I ICode] ,  (AlPCode),  Link,  no_alloc,  M,  D)  :- 
alloc_needed (I) ,  !, 

al loc_inst ruct ion (A,  M)  , 

peephole (( 1 1  Code ] ,  PCode,  Link,  yes_alloc,  M,  D)  . 

%  Insert  c  „i  to  dummy  procedure  if  using  old  allocate  instruction: 

%  Must  be  done  if  'try'  or  call/1  occurs  as  first  call. 

%  This  is  needed  to  initialize  the  N  register. 

peephole (( I ICode) ,  [ cal  1 (al locate_dummy/0, M) , 1 1 PCode ) ,  Link,  yes_alloc,  M, 


D) 


D=no_dummy, 
compile_options (a) , 

(I=. . (try |_] ;  I=cail/1),  !, 
peephole (Code,  PCode,  Link,  yes  alloc. 


M,  yes_dummy) 


%  Recognize  and  eliminate  superfluous  jumps: 
peepho le ( ( label (Lbl ) , execute (Lbl)  I  Code | , 

(execute (Lbl) I PCode ) ,  Link,  Alloc,  M,  D) 
peepho le (Code,  PCode,  Link,  Alloc,  M,  D) . 
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%  Remove  all  code  after  a  fail/0  until  reaching  a 
%  label,  retry,  or  trust: 

%  (calls  to  peephole  and  f_remove  must  be  in  this  order  for  best  working!) 
peephole ([ fail/0 I  Code ] ,  [ fail/0 I PCode ] ,  Link,  Alloc,  M,  D)  !, 

peephole (Code,  MCode,  Link,  Alloc,  M,  D) , 
f_remove (MCode ,  PCode). 

%  Optimize  unify  goals: 

%  First  case:  one  variable  is  temporary  or  void: 

peephole ( (put (variable, R, R) , get (A, X, R)  I  Code] ,  PCode,  Link,  Alloc,  M,  D)  :- 
R=x (I) , 

integer (I) ,  ! , 

peephole ( [put (A, X, R)  I  Code] ,  PCode,  Link,  Alloc,  M,  D)  . 

%  Second  case:  both  variables  are  permanent: 

%  What  if  X==Y??7 

peephole  (  [put  (A,  X,  x  (8) )  ,  get  (B,  Y,  x  (8)  )  I  Code] ,  PCode,  Link,  Alloc,  M,  D)  :- 
X\«=Y,  X=y ( N 1 ) ,  Y=y (N2 ) ,  ’, 
update_unsafe (A,  B,  NewA,  NewB) , 

PCode- [put (NewA, X, x ( 8 ) ) , get (NewB, Y, x  ( 8 ) )  I MCode  j , 
peephole (Code,  MCode,  Link,  Alloc,  M,  D) . 

%  Optimize  unify_cdr: 

peephole ( [unify (cdr, x (8) ), get (variable, X, x (8) ) ICode] ,  PCode,  Link,  Alloc,  M, 

D)  :-  !, 

peephole ( [unify (cdr, X)  I  Code] ,  PCode,  Link,  Alloc,  M,  D) . 
peephole ( [unify (cdr, x (8) ) , get (unsafe  value, X, x (8) )  I  Code] , 

(unify  (cdr,  x  (8)  )  ,  get  ( value, X,  x  (8) )  I  PCode] ,  Link,  Alloc,  M,  D)  :-  !, 
peephole (Code,  PCode,  Link,  Alloc,  M,  D) . 

%  Remove  superfluous  initializations  of  permanent  variables: 
peephole ( (put (value, y (_), x  (8) ), 1 1  Code] ,  PCode,  Link,  Alloc,  M,  D)  :- 
I=. . [Name |_] ,  Name\==get,  !, 

peephole  ([ I  I  Code] ,  PCode,  Link,  Alloc,  M,  D)  . 

%  Remove  no-op  register  transfers: 
peephole ([ I ICode] ,  PCode,  Link,  Alloc,  M,  D)  :- 
( I=get (variable, R, R) ;  I-put (value, R, R) ) , 

R=x (_) ,  !, 

peephole  (Code,  PCode,  Link,  Alloc,  M,  D)  . 

%  Remove  remaining  unsafe_values 

peephole ( [get (unsafe_value, A, B) ICode] ,  [get ( va lue, A, B) I PCode] ,  Link,  Alloc,  M, 
D)  :-  !, 

peephole (Code,  PCode,  Link,  Alloc,  M,  D) . 

%  Post-transformat  ion : 

%  Generates  code  for  some  built-ins  in  terms  of 
%  existing  instructions. 

peephole ( [Name/Arity ICode] ,  PCode,  Link,  Alloc,  M,  □)  :- 

post_trans (Name,  Arity,  TCode-Code) ,  !, 
peephole (TCode,  PCode,  Link,  Alloc,  M,  D) . 

%  Customization  of  instructions: 

peephole ([ I ICode] ,  [ClIPCode],  Link,  Alloc,  M,  D)  :- 
customize (X,  Cl) ,  ! , 

peephole (Code,  PCode,  Link,  Alloc,  M,  D) . 

%  Default: 

peephole ([ I ICode] ,  [IlPCode],  Link,  Alloc,  M,  D)  :- 
peephole (Code,  PCode,  Link,  Alloc,  M,  D) . 

%  Update  unsafe_vaiue  annotations  of  put-get  sequence: 
update_unsafe (A,  unsafe_value.  A,  value)  :-  !. 
update_unsafe (unsafe_value,  B,  value,  B)  :-  !. 
jpdate_unsa fe (A,  B,  A,  B)  :-  !. 


plm_coxnpiler  •  35 


plm_compiler 


%  Remove  code  until  encountering  a 

%  label,  retry,  or  trust: 

f_remove (V,  V)  var(V). 

f_remove ( [ Inst r I  Code ] ,  [ Inst r I  Code ] ) 

Instr= . . [N |_] , 

(N=label;  N=retry;  N=trust),  (. 
f_remove ( [_|Code] ,  RCode) 

f_remove (Code,  RCode). 

%  Table  of  built  ins  with  code: 

post_trans (var ,  1,  ( switch_on_term ( fail, fail, fail) I L] -L) . 

post_trans (non var,  1,  [switch_on_term(Lbl, Lbl,Lbl) , fail/0,  label (Lbl)  I L] -L)  . 
post_trans (atomic,  1,  [ switch_on_term (Lbl, fail, fail) , fail/0, label (Lbl)  |L]-L) . 

post_trans (nonatomic,  1,  [switch_on_term (fail, Lbl, Lbl) , label (Lbl) I L ] — L) . 
post_trans (list,  1,  (switch_on_term (fail,  Lbl, fail) ,  fail/0,  label (Lbl)  I L] -L) . 
post_trans (nonlist,  1,  [ switch_on_term (Lbl, fa il, Lbl) , label (Lbl ) I L ] — L ) . 

post_trans ( structure,  1,  [switch_on_term (f ail, fail, Lbl) , fail/0, label (Lbl) I L] -L) . 
post_trans (composite,  1,  (switch_on_term (fail, Lbl, Lbl) , fail/0, label (Lbl) I L] -L) . 
post_t rans (simple,  1,  ( switch_on_term ( Lbl, fail, fail) , label (Lbl) I L] -L) . 

post_trans (repeat,  0,  [ t ry (Lbl ) , label  (Lbl)  I L j -L)  . 

%  Customize  one  instruction: 

customize (get (structure, ' . ' / 2, B) ,  get_list (B) ) . 
customize (put (structure, ' . ' / 2, B) ,  put_list (B) ) . 
customize (put (constant, [ ] , A) ,  put_nil (A) ) . 
customize (get (constant, ( ] , A) ,  get_nil (A) ) . 

%  Succeeds  if  an  allocate  instruction  is  needed 
%  before  instruction  I: 
a 1 1 oc_needed ( I )  :- 

I=. . (Name  I , 

(Name=call;Name=try; l.ame=cut ) . 
a 1 loc_needed ( I )  :- 

(I=get  <_,V,  J  ;  I=put  (_,  V,  _)  ;  I=uni  fy  (_,  V) ) , 
nonvar (V) .  V=y (_) . 

%  Deallocate  at  last  code: 

lastcode (yes_alloc,  [deallocate  I L] ,  L) . 

lastcode (no_alloc,  L,  L) . 

%  The  allocate  instruction: 

alloc_instruction (allocate,  M)  :-  compile_options (a) ,  !. 

alloc_instruction (allocate (M) ,  M) . 

/*»***»»*»»*»»*»»»***»**»***»********»»***»»»*****»»****»»**»*»***»***»/ 

%  Help  information. 

%  Invoked  by  the  command  plm_help  or  plm_help (opt ion)  . 

plm_help  :- 
nl, 

write ('The  compiler  is  called  as  '), 
wr ite ( ' pirn ( f i lename)  or  pirn (f ilename, opt ionlist ) . ' 
write  ('The  options  in  optionlist  must  be  a  subset 
help_opt ionlist (OptList) , 
write  (OptList)  ,  write('.'),  nl, 

write('Call  plm_help (opt  ion)  for  more  information 


),  nl, 
of  ' )  , 

on  an  option.'),  nl. 


plm_he lp (Opt  ion) 
nl, 

nonvar (Option) , 
help_info (Option,  String), 
put  (9),  write (St ring) ,  nl, 
faii . 
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plm_help (Option)  : - 

he ip_opt ionl ist (OptList) , 

( (prolog_version (sbprolog)  ->  not (help_member (Option, OptList) ) ; 

\+  (help_member  (Option, OptList )  )  )  ; 

var (Option) ) , 

put (9) , write  (' The  option  '''), write  (Opt  ion) , write  ('' '  is  unknown. '),n 
put (9) , write (' The  known  options  are  in  the  set  '), 
write (OptList) ,  write ('.'), nl . 
pim_help (_) . 

help_opt ionl ist ( [a, 1, s, u,  q,  a  (_)  ] )  . 

nelp_info(a,  'Compile  an  allocate  instruction  without  arguments.'). 
help_info (a,  'The  default  is  to  use  a  single-argument  allocate  with  the'). 
help_info(a,  'environment  size  as  argument.'). 

help_info(l,  'Write  the  output  in  Prolog- readable  list  form.'). 
help_info(l,  'The  default  is  to  write  the  output  in  human-readable  form.'). 
help_info(u,  'Do  not  expand  calls  of  is/2  into  calls  of  is/4.'). 
help_info (u, 

'The  default  is  to  expand  is/2  into  is/4  whenever  it  is  possible.'). 
help_info(u,  'Option  u  overrides  option  s.'). 

heip_info(q,  'When  output  is  in  human-readable  form,  quote  all  atoms.') . 
heip_ir.fo  (q,  'The  default  is  to  quote  only  those  atoms  that  need  it.'). 
help_inf o (q, 

'Option  q  has  no  effect  when  option  1  (Proiog-reaaable  form)  is  used.'). 
help_info (a (X) , 

'The  parameter  of  a  (_)  (which  must  be  atomic)  is  appended  to  all'). 
help_info (a (X) , 

'labels  in  the  human-readable  code.  The  default  is  to  append  nothing.'). 
help_info (s, 

'Compile  the  operators  +,  -,  \/,  /\  in  an  expression  as  builtins,'). 
heip_info(s,  'and  only  the  others  with  is/4.  The  default  is  to  compile  all') 
help_info(s,  'operators  with  is/4.'). 
help_infc  (s, 

'Option  s  has  no  effect  when  option  u  (unexpanded  expression)  is  used.'). 
heip_member (X,  [ X : _ ] ) . 

help_member (X,  [_  L])  :-  he lp_member (X,  L) . 
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concat ( ( ] , L, L) . 

concat ( [XI  LI] ,  L2,  [XIL3] )  : -concat (LI, L2, L3) . 

a  ( 1 )  . 
a  (2)  . 
a  (3)  . 
a  (4)  . 

b ( [_] )  . 
b ( [a]  )  . 
b  (X)  . 


a  <A,B,C,D,E,F)  aUAIBJ.  [CID],  F,D,E,C). 
a  (A,  B,  C,  s, E, F)  a (F, E,  [AIC],  s(E,F),  A,  B)  . 
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plm  compiler .bench 


#  /* 

set-up. plm_compiler :  bench  set-up  for  plm_compiler 

*/ 

plm_compiler  :-  driver (plm_compiler) . 

benchmark (plm_compiler,  cap (Cl),  dummy (Cl),  10)  :- 

#if  BIM_PROLOG 
bim, 

#elseif  C_PROLOG 

c, 

♦elseif  QUINTUS_PROLOG 
quintus, 

♦else if  SB_PROLOG 
sb, 

♦elseif  SICTUS_PROLOG 
sicstus, 

♦endi  f 

options (test,  [ ] ) , 

see (test),  read_clauses (Cl) ,  seen. 

♦message  "NOTE:  show/1  is  NOT  defined  for  plm_compi ler" 


♦include  "driver" 


# 
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*  /* 

hoys.m:  benchmark  (tp)  boys  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s):  S _ OPTIONS _ S 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*% 


%%%%  %%%% 

%%%%  (tp)  boys  %%%% 

%%%%  %%%% 

%%%%  Ross  Overbeek  (overbeek@anl-mcs.arpa)  %%%% 

%ttt  %%%% 


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%»%%%%%%%%% 

*if  BENCH 

#  include  " .boys .bench" 

♦else 

boys  do (' examples/boys . ax' examples /boys . sos' ) ,  ! . 

♦option  SHOW  H 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  bench  ~ark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

#  if  SHOW 

show . 

#  e  dif 
♦endif 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (do/2)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 

#if  DUMMY 

do (_,  _)  . 

♦else 

i  include  "tp"  /*  code  for  propositional  theorem  prover  */ 

♦endi f 
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*  /* 

ct_2.m:  benchmark  (tp)  ct_2  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option  ( s )  :  S _ 0PT10NS__$ 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%»%%%%%%%%%%%%%%%%%%% 


%%%%  %%%% 

%%%%  (tp)  ct_2  ‘  %%%% 

%%%%  %%%* 

i%%%  Ross  Overbeek  (overbeekSanl-mcs . arpa )  %%%% 

%%%%  %%%% 


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
# if  BENCH 

♦  include  ".  ct_2 . bench “ 

♦  else 

ct_2  do (' examples/empty' ,' examples/ct_2 . sos' )  ,  !• 

♦option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

♦  if  SHOW 

show . 

♦  endif 
♦endi f 

♦option  DUMMY  » 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (do/2)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.” 

♦if  DUMMY 

do  (_,  _)  . 

♦  else 

♦  include  "tp"  /*  code  for  propositional  theorem  prover  */ 

♦endif 
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ct  3.a:  benchmark  (tp)  ct_3  master  file 

*/ 

%  generated:  _ MDAY _  _ MONTH _  _ _ YEAR _ 

%  opt  ion  (s):  S _ OPTION'S _ S  ~ 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
%%%%  %%%% 

%%%%  (tp)  ct_3  %%%% 

%%%%  %%%% 

%%%%  Ross  Overbeek  (overbeek@anl-mcs.arpa)  %%%% 

%%%%  %%%% 

%%%%%%%*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%»%%%%%%%%%%%%%%%%%%%%%% 

♦  if  BENCH 

s  include  ", ct_3 .bench" 

♦  else 

ct_3  do (' examples /empty' examples/ct_3 . sos'  )  ,  !. 

♦  opt ion  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

♦  i  f  SHOW 

show. 

♦  end if 
Ker.dif 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  oredicate  (do/2). 


>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  ana  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  wnen  BENCH  is  selected." 

♦if  DUMMY 

do (_,  _)  . 

♦  e  1  se 

♦  include  "tp"  /*  code  for  propositional  theorem  proven  */ 

♦  end  i  f 
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#  /* 

ct_4.m:  benchmark  (tp)  ct_4  master  file 

«/ 

%  generated:  _ MDAY _ MONTH_ _ YEAR _ 

%  option (s) :  $ _ OPTIONS _ S 

%%%**%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%»%% %%%%%% 


%%%%  %%%% 

%%%%  (tp)  ct_4  %%%% 

%%%%  %%%% 

%%%%  Ross  Overbeek  (overbeek@anl-mcs.arpa)  %%%% 

%%%%  %%%% 


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 

#if  BENCH 

*  include  " -ct_4 .bench" 

*  else 

ct_4  do (' examples/empty' examples/ct_4 . sos'  )  ,  !. 

((option  SHOW  11 

>  Option  SHOW  introduces  code  which.  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  tree  avai.aoie  through 

>  show/ I." 

*  if  SHOW 

show 

*  endif 
*enaif 


((option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (do/2). 

> 

>  To  use  this,  generate  coue  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected, 
(tif  DUMMY 
do  (  ,  _)  . 

(te '  ue 

%  include  "tp" 

Kend i f 


/*  code  for  propositional  theorem  prover  */ 


ct  5  .m 


♦  /* 

ct_5.m:  benchmark  (tp)  ct_5  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option  (s)  :  S _ OPTIONS_$ 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*%%%%»%%%%%%%%%»%%%%%%% 


%%*%  %%%% 

%%%%  (tp)  ct_5  %%%% 

%%%%  %%%% 

%%%%  Ross  Overbeek  (overbeek@anl-m.es . arpa)  %%%% 

%%%%  %%%% 


%%%%%%%%%%%%%%%%%%%%%%%*%%%%*%%%%*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
♦if  BENCH 

♦  include  " ,ct_5 .bench" 

♦  else 

ct_5  do  (' examples/empty examples/ct_5 . sos' ) ,  !. 

♦option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

♦  if  SHOW 

show . 

♦  endif 
♦endif 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (do/2)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automat ical ly  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 

♦if  DUMMY 

do  (_,_)  . 

♦  else 

♦  include  ”tp"  /*  code  for  propositional  theorem  prover  */ 

♦endif 
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♦  /* 

ct_6.m:  benchmark  (tp)  ct_6  master  file 

*/ 

%  generated:  _ MDAY _  _ _ MONTH _ YEAR _ 

%  option (s) :  $ _ OPTIONS _ S 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%»%%%%%%%%%%%%%%%%%%%%% 


%%%% 

%%%% 

%%%% 

(tp)  ct_6 

%%%% 

%%%% 

%%%% 

%%%% 

Ross  Overbeek  (overbeek@ani-mcs.arpa) 

%%%% 

%%%% 

%%%% 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 

♦  If  BENCH 

♦  include  ". ct_6 . bench" 

#e  1  se 

ci_6  do (' examples/empty ',' examples/ct_6 . sos' )  ,  !. 

♦option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/ l." 

♦  if  SHOW 

show. 

♦  endif 
♦endif 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (do/2)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected.” 

♦if  DUMMY 

do (_,  _)  . 

♦  else 

♦  include  "tp"  /*  code  for  propositional  theorem  prover  */ 

♦endif 
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*  /* 

tp:  code  for  propositional  theorem  prover  (Prolog  version) 

*/ 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 


%%%%  %%%% 

%%%%  Uniprocessor  Version  of  Propositional  Theorem  Prover  %%%% 
%%%%  %%%% 

%%%%  This  version  corresponds  to  the  version  in  C.  It  %%%% 

%%%%  accepts  input  in  the  same  format  as  the  C  version.  %%%% 

%%%%  %%%% 


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%»%%%%%%%%%% 

//*w*'*r**********w***i*'*'<r**-******************w**'**'**w*'»r***********llr*** 

To  understand  what  this  benchmark  is  designed  to  stress,  one  needs 
to  know  a  little  about  how  theorem  provers  run.  Essentially,  this 
program  reads  in  two  sets  of  formulas: 

The  first  set  is  called  the  "axioms".  These  formulas  are 
placed  into  the  "usable  formulas"  list. 

The  second  set  of  formulas  is  the  initial  contents  of  the 
"set  of  support"  list. 

For  convenience,  the  first  set  is  processed  by  adding  each  formula 
to  the  "set  of  support"  and  then  moving  each  formula  to  the  "usable 
formulas"  list. 

I  will  try  to  use  the  term  "formula"  when  I'm  talking  about  a 
clause  in  the  propositional  calculus  (to  distinguish  these  from 
Prolog  clauses)  .  All  of  the  formulas  input  to  the  program  or 
derived  by  the  program  are  clauses  in  the  propositional  calculus. 

The  program  builds  an  initial  database  of  the  form 

database (Sos.Nextld, IndexAll, IndexUsable, IdLcokup) 

Here. 

Sos  is  a  structure  of  the  form 

sosfclist  of  clauses  that  contain  1  literal?, 

<list  of  clauses  that  contain  2  literals?, 

clist  of  clauses  that  contain  3  literals?. 


clist  of  clauses  that  contain  28  literals?) 

It  is,  as  Richard  O'Keefe  pointed  out,  a  priority  queue. 

Entries  are  extracted  when  a  new  “given  formula"  is  needed  by 
selecting  the  first  clause  with  the  least  number  of  literals. 

Nextld  is  an  integer  which  gives  the  value  that  can  be 
assigned  as  an  id  to  the  next  formula  added  to  the  database 

IndexAll  is  an  "index"  that  is  used  to  access  all  clauses  that 
occur  in  either  the  set  of  support  or  the  usable  formulas  list. 

indextsable  is  an  "index”  that  is  used  to  access  all  clauses  that 
occur  in  the  usable  formulas  list. 

IdLookup  is  an  "array"  used  to  locate  a  formula  with  a  designated 
id . 

An  "index"  is  a  structure  of  the  form 
index  (PosIndex.Neglndex) 
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where 


Poslndex  is  of  the  form 

pos(<list  of  clauses  containing  v0>, 
<list  of  clauses  containing  vl>, 
<list  of  clauses  containing  v2>. 


<list  of  clauses  containing  v27>) 

Neglndex  is  of  the  form 

neg(<list  of  clauses  containing  -v0>, 
<list  of  clauses  containing  -vl>, 
<list  of  clauses  containing  -v2>. 


<list  of  clauses  containing  -v27>) 

This  "database"  is  really  a  mechanism  for  efficiently  accessing 
the  formulas  composing  the  "set  of  support  list"  and  the  "usable 
formulas  list",  which  are  just  abstractions.  There  is  no  actual 
list  called  set-of-support  (rather,  Sos  is  a  structure  through 
which  these  formulas  are  accessed)  or  usable-formulas  (rather, 
these  formulas  are  accessed  through  the  IndexUsable  structure) . 

Execution  of  the  program  causes  the  input  formulas  to  be  used  to 
make  an  initial  database.  Then,  until  the  null  clause  is  derived 
or  the  set-of-support  becomes  empty,  the  following  procedure  is 
just  repeated: 

pick  a  clause  from  the  set-of-support  (with  a  minimum 
number  of  literals) 

move  it  to  the  usable-formulas  list 

form  all  binary  resolvents  that  can  be  formed  from  the  given 
clause  and  another  member  of  the  usable-formulas  list 

for  each  generated  resolvent, 

if  it  is  subsumed  by  an  existing  clause, 
or  if  it  is  a  tautology, 

just  ignore  it 


deiete  all  clauses  tnat  already  exist, 

but  that  are  subsumed  by  the  generated  clause 

The  deletion  is  a  bit  tricky.  Actually,  we  just  accumulate  a  list 
of  the  ids  of  clauses  subsumed  by  new  resolvents  produced  by  a 
single  given  clause;  once  generation  of  resolvents  has  completed 
for  the  given  formula,  then  all  of  the  clauses  to  be  deleted  are 
deleted. 

The  problem  is  that  each  addition  to  the  formula  database  and  each 
deletion  of  the  set  of  clauses  "back-subsumed"  by  clauses  derived 
from  a  given  clause  produces  a  new  database  (built  from  contents  of 
the  previous  database) .  A  Prolog  that  is  not  smart  enough  to  use 
destructive  assignment  (and  none  are,  at  this  time)  accumulates  a 
massive  number  of  structures  on  the  heap.  The  time  spent  to  build 
these  structures  and  t!  ;  garbage  collection  caused  by  this  copying 
constitute  a  real  performance  problem. 

#«♦******************************#*********,**********************  j 
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#option  “ 

>  For  use  with  Quintus  Prolog,  tp  requires  a 

>  Quintus  Prolog-specific  directive.  It  is 

>  generated  if  option  QUINTUS_PL  is  selected." 

# if  QUINTUS_PL 

unknown (_, fail) . 

#endi f 
*  /* 

tp  read_file_name (axioms, AxiomFileName) , 

read_f ile_name (sos, SosFileName) , 
do (AxiomFileName, SosFileName) . 

*/ 

do (AxiomFileName, SosFileName)  : - 
initialize_database (Db)  , 

process_axiom_f ile (AxiomFileName, state (Db  false) ,Statel, Symbols) , 
process_sos_f ile (SosFileName, Statei,State2, Symbols) , 
process_events (State2,  State3) , 

(  show  ->  display_f inal_status (State3)  ;  true  ). 

display_final_status  (state (_, true) )  write ('Proof  found'),  nl. 
display_final_status  (state  (_, false) )  write  ('Proof  not  found'),  nl. 

process_events (state (Db, true) , state (Db,  true) )  . 
process_e  vents  (state  (Db,  false),state(Db,false)) 
sos (Db, Sos) , 
empty_sos (Sos)  . 

process_e vents (state (Db, false) , News t ate)  : - 
sos (Db, Sos) , 

pick_given_f ormula (Sos, Given) ,  % 

(  show  ->  writelist ( [given, Given ] 
nove_to_usable (Db, Given,  Dbl)  , 
gen_and_chk (Dbl, Given, NewDb, NewStatus) , 
process_e vents ( state (NewDb, NewStatus) , News t ate) . 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%»%%%%%%%%%%%%%%%%%%%%%%%%%%% 

%%%  %%% 

%%%  Resolvent  generation  code  %%% 

%%%  %%% 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 

gen_and_chk (Db, Id, NewDb, Status)  : - 
id_iookup (Db, IdLookUp)  , 

array ( IdLookUp, Id, clause ( Id, _, Pos, Neg) ) , 
get_literals(Pos,PosLits)  , 
get_literals (Neg,  NegLits)  , 

index_usable (Db, index (Poslndex, Neglndex) ) , 

gen_resolvents(PosLits,Pos,  Neg,  Id, Db,  Neg Index,  pos,Dbl,Statusl)  , 
cont_generat ion (Statusl,Pos, Neg, Id, Dbl , Poslndex, neg, 

NewDb, Status, NegLits) . 

cont_generation ( true, _, Db,  Db,  t  rue,  _) . 

cont_generat ion ( false, Pos, Neg, Id, Db, Index, Type, NewDb, Status, Lits)  :  - 
gen_resol vent s (Li ts, Pos, Neg, Id, Db, Index, Type,  NewDb,  Status)  . 

gen  _resol  vents  (  [  J Db, Db,  false)  . 

gen_ re sol vents ( [ClashLit I T ] , Pos, Neg, Id, Db, Index, Type, NewDb, Status) 
arg(ClashLit, Index, ClauseList )  , 
gen_reso 1 vent s_on_li t (ClauseList, Pos,  Neg,  Id, 

Db, ClashLit, Type, Dbl,Statusl,DelList), 
de lete_£rom_database_c lauses (QelList,Dbl,  Db2)  , 
cont_generat ion (Statusl , Pos, Neg, Id,  Db2, Index,  Type, 

NewDb, Status, T) . 


pick  from  set-of-support 
,  nl  ;  true  ) , 


gen_reso 1  vent s  on  1 i t  ( [ 


_,  Db,  ,_,  Db,  false,  [  ]  ) 
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gen_resolvents_on_l.it  ( [Clause  !  T] , Pos,  Neg,  Id,  Db, ClashLit,  Type,  NewDb,  Status, 
DeiList) 

gen_one_re sol vent (Clause, Pos, Neg, Id, Db, ClashLit,  Type, Dbl,  Statusl, 
DeiList, NewEnd) , 

cont_generat ion_on_lit (Statusl, Pos,  Neg, Id, Dbl,  ClashLit, Type,  NewDb, 
Status, T, NewEnd) . 

gen_one_resolvent (clause (Par2Id,_, Par2Pos, Par2Neg) , Pos, Neg, 

Pari Id, Db, ClashLit, Type, NewDb, Status, DeiList , NewEnd)  : - 
form_re sol vent (Type, Pos, Neg, Par2Pos, P a r2Neg, ClashLit , ResPos, ResNeg) , 

(  empty_clause (ResPos, ResNeg)  -> 

Status  =  true, 

(  show  -> 

writ el 1st ( [derived, empty, clause, from, [ParlId,Par2ld]]),  nl 
;  /*  otherwise  ->  */ 
true 

) 

;  /*  otherwise  ->  */ 

Status  =  false, 

subsume_and_add (Db, ResPos, ResNeg, [PariId,Par2ld] , NewDb, DeiList , 


subsume_and  add (Db, ResPos, ResNeg, Parents, NewDb, DeiList , NewEnd)  : - 

(  ( forward_subsumed (Db, ResPos, ResNeg)  ;  tautology (ResPos, ResNeg)  )  -> 

NewDb  =  Db, 

NewEnd  =  DeiList 
;  /*  otherwise  ->  */ 

ada_to_sos (Db, clause (Parents, ResPos, ResNeg) , NewDb, Newld) , 

(  show  -> 

write_added_mesg (Newld, clause (Parents, ResPos, ResNeg) ) 

;  /*  otherwise  ->  */ 
true 

)  , 

back_subsumpt ion (Db, Newld, ResPos, ResNeg, DeiList, NewEnd) 

)  . 

tautology (Pos, Neg) 

0  =\=  Pos  /\  Neg. 

conc_generation_on_lit (true, Db,_,_, Db, true,_, []) . 
cont_generat ion_on_lit ( false, Pos, Neg, Id, Db, ClashLit , Type, NewDb, Status, 
ClauseList, DeiList) 

gen_re sol vent s_on_lit (ClauseList, Pos, Neg, Id, Db, ClashLit , Type, 

NewDb, Status, DeiList ) . 


empty_clause (0 , 0) . 

form_reso Ivent (pos, Posl, Negl, Pos2, Neg2, ClashLit, ResPos, ResNeg)  : - 
form_resol vent (Posl, Negl, Pos2, Neg2, ClashLit, ResPos, ResNeg) 
form_ resolvent (neg, Pos2, Neg2, Posl, Negl , ClashLit , ResPos, ResNeg)  :  - 
form_ resolvent (Posl, Negl, Pos2, Nea2, Clasn Lit, ResPos, ResNeg) 

f or m_ resol vent (Par lPos, Par lNeg, Par2Pos, Par2Neg, 

ClashLit, ResPos Word, ResNegWord)  : - 
Mask  is  \(1  <<  (ClashLit  -  D), 

ResPosWord  is  (  (ParlPos  /\  Mask)  \/  Par2Pos) , 

ResNegWord  is  (  (Par2Neg  /\  Mask)  \/  ParlNeg)  . 


delete _f rom_database_clauses (List , Db, NewDb)  : - 

de lete_f rom_database_clauses (List, [ ] , Db, NewDb) . 


delete 

delete 


f rom_database_clauses ([),_, Db, Db) . 
f  rom_database_clauses ( [ Id  I  Rest ] , L, Db, NewDb)  : - 
(  u_member ( Id, L)  -> 

delete_f rom_database_ciauses (Rest, L, Db, NewDb) 

;  /*  otherwise  ->  */ 

de lete_from_dat abase (Db, Id,  Dbl )  , 

delete_f rom_database_clauses (Rest,  [ Id  I L) , Dbl, NewDb) 
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%%%%%%%%%»%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*%%%%%%%%%%%%%%%%%%%%% 
%%%  %%% 

l%%  Subsumption  code  %%% 

%%%  %%% 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%»%%%%»%%%%%*%%%%%%%%*%%%%%%%%%% 


forward_subsumed  (Db, Pos, Neg) 

index_all  (Db,  index  (Pos Index,  _)  )  , 
get_next_literal (Pos,  PosLit)  , 
indexed_subsumed_by (PosLit, poslndex, Pos, Neg) . 
forward_subsumed (Db, Pos, Neg) 

index_all (Db, index (_, Neglndex) )  , 
get_next_literal (Neg,  NegLit)  , 
inaexed_subsumed_by (NegLit , Neglndex,  Pos,  Neg) , 


indexed_subsumed_by (Lit, Index, Pos,  Neg)  : - 
arg (Lit, Index, ClauseList)  , 

u_member (clause (_,_, SubsumerPos, SubsumerNeg) , ClauseList)  , 
subsumes  (SubsumerPos, SubsumerNeg, Pos, Neg) . 


subsumes (Posl, Negl, Pos2, Neg2) 

Posl  =:=  (Posl  /\  Pos2) , 

Negl  =:=  (Negl  /\  Neg2) . 

back_subsumpt ion  (Db,  Subld,  Pos,  Neg,  DelList,  NewEnd) 
index_all (Db, IndexAll) , 

indexed_back_subsumed_by (Subld, IndexAll, Pos, Neg, DelList, NewEnd) . 

indexed_back_subsumed_by (Subld, IndexAll, Pos, Neg, DelList, NewEnd) 

(  Pos  =\=  0  -> 

get_f  irst_literal  (Pos,  H)  , 

IndexAll  =  index  (Poslndex,  _)  , 
arg  (H,  Poslndex,  ClauseList) 

;  Neg  =\=  0  -> 

get_first_literal  (Neg, H) , 

IndexAll  =  index (_, Neglndex) , 
arg (H, Neglndex, ClauseList) 

)  , 

back sub (ClauseList, Subld, Pos, Neg, DelList , NewEnd)  . 

backsub  X,  X)  . 

back sub ( ( clause ( Id, _, Pos, Neg) I T ] , Subld, SubsumerPos, SubsumerNeg, DelList, 
NewEnd) 

(  subsumes (SubsumerPos, SubsumerNeg, Pos, Neg)  -> 

(  show  ->  write_subsumed_mesg (Id, Subld)  ;  true  ), 
add_element (DelList, Id, EndList) 

;  /*  otherwise  ->  */ 

EndList  =  DelList 

)  , 

backsub IT,  Subld,  SubsumerPos, SubsumerNeg, EndList, NewEnd)  . 
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%%%  %%% 

%%%  Database  utilities 

%%% 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% *%%%%%%%%%%%%*%%%%%%%%% 

sos  (database  ( So s  _)  ,  Sos)  . 

next_id (database (_, Next  Id, _) , Nextld)  . 

index_all (database (_, IndexAll,_, _) , InaexAl 1 ) . 

index  usable  (database  IndexUsable,  ,  IndexUsable)  . 

id_lookup  (database  (_,  _,  _,  _,  IdLookup)  ,  IdLookup)  . 

pos  index ( index (Pos ,_), Pos) . 

neg_index ( index (_, Neg)  ,  Neg)  . 

empty  sos ( sos_by  weight  (  f] ,  [ i ,  [  i ,  ( i ,  ( ] ,  i  j ,  '  J .  !  i ,  [ ] ,  1 ! ,  ( J  <  ( i ,  M  »  [3  / 

"  ~  ""  i  i .  i  j , :  3 ,  n ,  e  i .  u ,  o ,(],[],  n ,  n )  > 

create_index ( index (pos ( f ] ,  [  ] ,  [ ] ,  [ ! ,  ( 1 ,  i ) ,  ' i ,  i 3 ,  ! 3 ,  1] ,  [ ] ,  [ ) ,  [  ]  ,  U  , 

n,  u.  n.  u.  ii.  ilil  u.u.  u.  n.  n.  n.  m, 

neg  (II,  i] ,[],[],  l  ],[],[],[],  l  ].[],  U  ,[].[  1 .  H  , 

n,  n,  (!,  u,  [],  ii,  n,  n,  n,  ii,  n,u,  u,  (in) 

database  vars (database (Sos, Nextld, IndexAl 1 , IndexUsable , IdLookup) , 
Sos, Nextld, IndexAll, IndexUsable, IdLookup) . 

make_database (Sos, Nextld, IndexAll, IndexUsable, IdLookup, 

database (Sos , Next  Id, IndexAll, IndexUsable , IdLookup) )  . 

initialize_database (database (Sos, 1, IndexAll,  IndexUsable, IdLookUp) ) 
create_index  ( IndexAll)  , 
create_index ( IndexUsable) , 
new_array (IdLookUp)  , 
sos_by_weight (Sos) . 

sos_by__weight  (Sos) 

functor (Sos, sos_by_weight , 28) , 
empty_sos (Sos) . 

pick_given_formula (Sos,  Id) 

pick_given_formula (Sos, 1,  Id) . 

pick_given_formula (Sos, ArgNum,  Id)  : - 
ArgNum  <  29, 
arg  (ArgNum, Sos, Arg) , 

(  Arg  =  ( Id  I  _]  -> 
true 

;  /*  otherwise  ->  */ 

NewArgNum  is  ArgNum  *  1, 
pick_given_formula (Sos,  NewArgNum,  Id) 

)  . 


J 
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%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%»%%%%%%%%%%%% 
%%%  %%% 
%%%  Input  processing  code  %%% 

%%%  ’  %%% 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%»%%%%%%%%%%%%%%%%% 


*  /  * 

reaa_f ile_name (Type, FileName)  : - 
write('Enter  filename  for 
read (Fi leName) . 


),  write  (Type),  write(': 


*/ 

process_axiom_f i ie (File, State, Newstate, Symbols) 
see  (File)  , 

process_axiom_input (State, Newstate, ! J , Symbols) , 
seen . 

process_sos_f ile(File, State, Newstate, Symbols)  : - 
see  (File) , 

process_sos_  input  (State,  News -ate,  Symbols,  _)  , 
seen . 

process_axiom_ input (state  (Db, Status) .state (NewDb, Status) , Symbols, NewSym)  : - 
(  read_one_dause  (Clause,  Symbols,  Symbols2)  -> 
add_to_sos (Db, Clause, Dbl, Id) , 

(  show  ->  write_added_mesg (Id, Clause)  ;  true  ), 
move_to_usable  (Dbl,  Id,  Db2)  , 

process_axiom_input (state (Db2, Status) , state (NewDb, Status) , 
Symbols2, NewSym) 

;  /*  otherwise  ->  */ 

NewSym  =  Symbols, 

NewDb  =  Db 

)  . 

process_sos_input (state (Db, Status) , state (NewDb, Status) , Symbo 1 s , NewSym) 

(  read_one_cl ause (Clause, Symbols, Symbols2)  -> 
aad_to_sos (Db, Clause, Dbl, Id) , 

(  show  ->  wr ite_added_mesg ( Id, Clause)  ;  true  ), 
process_sos_input (state (Dbl, Status) , state (NewDb, Status) , 
Symbois2, NewSym) 

;  /*  otherwise  ->  */ 

NewSym  =  Symbols, 

NewDb  -  Db 

)  . 


read_one_clause (clause) [-1,-1], Pos, Neg) , Symbols,  NewSym)  : - 
read (Term) , 

Term  \==  end_of_file, 
term_to_iist (Term,  CList)  , 

set_bit s (CList , 0 , 0 , Pos, Neg, Symbols,  NewSym)  . 


term_to_l 1st ( (First, -Rest) ,  (First i T ) )  :  - 

term_to_list (Rest, T) . 
term_to_l ist (Te rm, (Term)) 

1 +  Term  •  (  ;  )  . 


set_bits ( [ ] , Pos, Neg, Pos, Neg, Symbols, Symbols) . 
set_bits((HlT],InitPos, In  it Neg, NewPos, NewNeg, Symbols, NewSym) 

I ookup_ symbol (H, Symbo INumber , Type, Symbols, Symbol si ) , 

(  Type  =  pos  -> 

turn_bit_on ( InitPos, SymbolNumber, PosWord) , 
set _b it  s (T, PosWord, InitNeg, NewPos, NewNeg, Symbo Is  1 , NewSym) 
;  /*  otherwise  ->  */ 

turn_bit_on ( InitNeg, SymbolNumber, NegWord) , 

set_bits  (T, InitPos, NegWord, NewPos,  NewNeg, Symbol s 1 ,  NewSym) 

)  . 

iurn_bit_on (Word,3itPos, NewWord) 

NewWord  is  (Word  \/  (1  <<  (BitPos  -  1))). 
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iookup_symbol (-Symbol, Symbol Number, neg,  Symbols,  NewSym)  : - 
(  u_member  (  (Symbol,  SymbolNumber)  ,  Symbols)  -> 

NewSym  =  Symbols 
;  /*  otherwise  ->  */ 

u_length (Symbols,  I )  , 

SymbolNumber  is  1+1, 

NewSym  =  [ (Symbol, SymbolNumber)  I  Symbols] 

)  . 

lookup_symbol (Symbol, SymbolNumber, pos, Symbols, NewSym)  : - 
(  u_member ( (Symbol, SymbolNumber) ,  Symbols)  -> 

NewSym  =  Symbols 
;  /*  otherwise  ->  */ 

u_lengt.h  (Symbols,  I)  , 

SymbolNumber  is  1*1, 

NewSym  =  [ (Symbol, SymbolNumber)  I  Symbols] 

)  . 

get_literals (Word, Literals)  get_literals (Word, Literals, 1) . 

get_literais (Word, List, N) 

(  (Word  =:=  0  ;  N  =:=  29)  -> 

List  -  ( ] 

;  /*  otherwise  ->  ”/ 

J  is  (N  *  1)  , 

Wordl  is  (Word  >>  i), 

(  0  =:=  (Word  /\  1)  -> 

get_l iter a  Is (Wordl, List ,  J) 

;  /*  otherwise  ->  */ 

List  =  [N i List  1 ] , 

get_l iter a  Is (Wordl, List  1, J) 


get_first_literal( Word, Literal) 

get_next_l itera 1 (Word, Literal)  ,  ! . 

get_r.ext_i  iter  a  1  (Word,  Li  tera  1 )  :  -  get_next_literal  (Word, Literal,!)  . 


next_iiteral (Word, N, N) 

N  <  29, 

1  is  (Word  /\  1)  . 
next_litera  1  (Word,  Literal,  N) 

N  <  28, 

I  is  N+l, 

Wordl  is  (Word  >>  1), 
get_next_literal (Wordl,  Literal,  I)  . 
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%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%»%%%%%%%%%%%%%% 
%%%  %%% 

%%%  Indexing  routines  %%% 

%%%  %%% 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%»%%%%%%%%%%%%%%%%%%%%%%%%%% 


add_to_sos (Db, clause (Parents, Pos, Neg) , NewDb, Nextld) 

database_vars (Db, Sos, Nextld, Allindex, Usablelndex, IdLookUp) , 
NewNextld  is  Nextld  +  1, 

Clause  =  clause (Nextld, Parents, Pos, Neg) , 
add_index_entry (Allindex, Clause, Pos, Neg, NewAllIndex) , 
num_lits  (Pos,  Neg,  NuntLits)  , 

add_by_weight_to_sos (Sos, NumLit  s, Next  Id, NewSos) , 
array ( IdLookUp, Nextld, Clause) , 
make_database (NewSos, 

NewNextld, NewAllIndex, Usablelndex, IdLookUp, NewDb) . 
raove_to_usable (Db, Id, NewDb) 

dat abase_vars (Db,  Sos,  Next  Id, A1 1 Index, Usable  Index, IdLookUp) , 
delete_from_sos (Sos, Id, NewSos, Clause, IdLookUp) , 

Clause  =  clause (Id, _, Pos, Neg) , 

add_ index  entry (Usablelndex, Clause, Pos, Neg, NewUsablelndex) , 
make_database (NewSos, 

Nextld, A1 1 Index, NewU sable Index, IdLookUp, NewDb) . 

delete_f rom_database (Db, Id, NewDb) 

database_vars (Db, Sos, Nextld, Allindex, Usablelndex, IdLookUp) , 
delete_f rom_sos (Sos, Id, NewSos, Clause, IdLookUp) , 

I 

Clause  «  clause (Id, _, Pos, Neg) , 

delete_index_ent  ry  (Al  1  Index,  Id,  Pos,  Neg,  NewAl  1  Index)  , 
make_database (NewSos, Nextld, 

NewAl il-dex, Usablelndex, IdLookUp, NewDb) . 
delece_f rom_database (Db, Id, NewDb)  : - 

database_vars (Db, Sos, Nextld, Al 1 Index, Usable  Index, IdLookUp)  , 
array ( IdLookUp, Id, Clause) , 

Clause  =  clausedd,  , Pos, Neg), 

delete_index_entry (Allindex, Id, Pos, Neg, NewAllIndex) , 
deiete_index_entry (Usablelndex, Id, Pos, Neg, NewUsablelndex) , 
make_database (Sos, Nextld, 

NewAl .Index,  NewUsablelndex,  IdLookUp, NewDb)  . 

add_index_ent ry ( Index, Pt  rC lause, Pos , Neg, New Index)  : - 
pos_ index ( Index, Pos Index) , 
get_literals(Pos,PosLits), 

add_to_index_l i st (PosLits, Poslndex,  PtrClause,  NewPosIndex)  , 
neg_index (Index, Neg Index) , 
get_iiterals(Neg, NegLi ts) , 

add_to_ir  '  .«_list ( NegLi ts, Neg Index, PtrClause, NewNeg Index) , 
pos_index (New  Index, NewPosIndex) , 
neg_ index (New Index, NewNeg Index)  . 

add_t o_index_l ist ( Li t  s, Index, Clause, New Index)  : - 

add_to_index_list s (Lit s, Index, Clause, TnitChangeList )  , 
functor ( Index, Functor, Arity) , 
f unct or (New  Index, Functor, Arity), 

form_updated_ index (In ItChangeList .Arity, Index, New Index) . 

add_to_index_l ists ( (LiteralNumlTail), Index, Clause, In it Change)  : - 
arg(LiteralNum,  Index,  Arg)  , 

add_element (InitChange,  (Litera INum,  (Clause  I Arg] ) , NewChangeList ) , 
add_to_index_l ist s (Tail, Index, Clause, NewChangeList ) . 
add_ t o_index_ 1 i st s ( [ ] ,  ,_,[]). 
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del ete_index_ent ry ( Index, Clause  Id, Pos, Neg, Newlndex)  : - 
pos_index { Index, Poslndex) , 
get_literais (Dos, PosLits) , 

delete_f rom_index_list (PosLits, Poslndex, Clause  Id, NewP os Index) 
neg_index ( Index, Neglndex) , 
get_liter als (Neg, NegLits) , 

de lete  f rom_index_list (NegLits, Neglndex, Clause  Id, NewNeg Index) 
pos__index  (Newlndex,  NewPosIndex)  , 
neg_index (Newlndex, NewNeglndex) . 

delete_f rom_index_list (Lit s, Index, Clause , Newlndex) 

delete_f rom_index_lists  (Lits,  Index,  Clause,  InitChangeList )  , 
functor ( Index, Functor,  Arity)  , 
functor (Newlndex, Functor,  Arity)  , 

form_updatea_index (InitChangeList , Arity, Index, Newlndex) . 

delete_f rom_index_lists ( [LiteralNumi Tail ] , Index, Clauseld, InitChange) 
arg (LiteralNum, Index, Arg) , 

delete (clause  (Clauseld,  , Arg, NewArg)  , 

add_element ( InitChange, (LiteralNum, NewArg) , NewChangeList ) , 
delete  from_index_li sts (Tai 1, Index, Clauseld, NewChangeList ) . 
de iete_f rom_index_ lists ([],_,_, ( ] ) . 

nu;n_l  its  (Pos,  Neg,  NumLits) 

get_literals (Pcs, PosL; ts) , 
get_iiterals (Neg, Ne*„-its ) , 
u_length (PosLits, PosLength) , 
u_length (NegLits, NegLength) , 

NumLits  is  PosLength  +  NegLength, 


aad_by_weight_to_sos (Sos, NumLits, Clauseld, NewS os) 
arg (NumLits, Sos, Literal Arg) , 

argrep (NumLits, Sos, [Clauseld ' LiteraiArg] , NewSos) . 

delete_f  rom_sos  (Sos,  Id,  NewSos,  Clause,  IdLcokL'p)  :  - 
array ( IdLockUp, Id, Clause) , 

Clause  =  clause Pos, Neg) , 
num_i its (Pos, Neg, NumLits) , 
arg (NumLits, Sos, Arg) , 
delete(Id,Arg, NewArg) , 

argrep (NumLits, Sos, NewArg, NewSos) . 
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%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*%%%%%%%%%%%%»*%%%%%%%%%%%%%%%%% 

%%%  %%% 

%%%  Utility  routines  %%% 

%%%  %%% 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%»%%%%%%%%% 

database (state (Db, _) , Db) . 

proof_completed (state (_, ProofCompleted) , ProofCompleted) . 
make_state (Db, ProofCompleted, state (Db,  ProofCompleted)  )  . 

%  u_  prefix  to  avoid  confusion  with  member/2  which  may  or  may  not  be  built-in 
u_member(X,  [X I _ ] )  . 

u_member (X, [_ I Y] )  u_member (X, Y) . 

%  u_  prefix  to  avoid  confusion  with  length/2  which  may  or  may  not  be  built-in 
u_length ( [ ] ,  0)  . 

u_length ( [_ I T] , N)  :-  u_length (T, I) ,  N  is  1+1. 
delete  (X,  (X|YJ,Y)  . 

delete  (X,  [HIT],  [HIT2])  :-  delete  (X, T, T2) . 

writelist  (  ( ]  )  . 

writelist  (  [HI T] )  write(H),  write!'  '),  writelist (T)  . 

argrep  (N,  Old,  Value,  New) 

functor (Old, Functor, Arity) , 
functor  (New,  Functor,  Arity)  , 
argrep (Old,  1, Arity, N, Value, New)  . 

argrep (Term, ArgNo, Arity, Index, Value, NewTerm)  :- 
(  ArgNo  >  Arity  -> 
true 

;  /*  otherwise  ->  */ 

(  ArgNo  =:=  Index  -> 

arg (ArgNo, NewTerm,  Value) 

;  /*  otherwise  ->  */ 

arg (ArgNo, Term, ArgVal ) , 
arg (ArgNo, NewTerm,  ArgVal) 

)  , 

NewArgNo  is  ArgNo  +  1, 

argrep (Term, NewArgNo, Ar it y, Index,  Value, NewTerm) 

)  . 


% - 

%  The  following  two  predicates  are  used  to  define  an  empty  array 
%  and  set  values  in  it. 

%  new_array (-Array ) 
new_array(A) 

functor  (A,  array,  100)  . 

%  array  (rArray,  ^-Subscript,  /Value) 

%  J  gives  the  offset  for  entry  in  array  A,  K  gives  the  offset  in  the 
%  Jth  entry  of  the  array.  We  consider  that  A  is  an  array  of  arrays. 

array  (A,  I,  E)  :  - 

J  is  ( (I  -  1)  //  100)  +  1, 

K  is  (  (I  -  1)  mod  100)  +  1, 
arg ( J, A, SubArray) , 

( var (SubArray)  ->  functor (SubArray, array, 100) ;  true), 
arg (K, SubArray, E)  . 
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%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
%%%  %%% 
%%%  Routines  foe  writing  clauses  in  readable  form  %%% 

%%%  ”  %%% 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 


convert_to_external_form(Pos,  Neg) 
get_literals(Pos,PosList) , 
write_pos_symbols (PosList)  , 
get_literals (Neg, NegList )  , 

(  (NegList  =  [ _ ( _ ] ,  PosList  =  '_;_))  -> 

write ( *  I  * ) 

;  /*  otherwise  ->  */ 


write_neg_symbois (NegList)  . 

write_pos_symbols ( ( ] )  . 
write_pos_symfcois ( [H ! T) ) 

write(v),  write(H), 

(  T  -  []  -> 

t  rue 

;  /*  otherwise  ->  */ 

write  ('  !  '  ) 

)  , 

write_pos_symbols (T) . 

write_neg_symbols ( [ ] ) . 
write_neg_symbols ( [H I T] ) 
write 

write  (v) ,  write  (H) , 

(  T  =  []  -> 

true 

;  /*  otherwise  ->  */ 

write  ('  !  ' ) 

)  , 

write_neg_symbois (T  > . 

form_updated_index ( InitChangeList , Arity,  Index,  Newlndex)  :  - 

form_updated_index (InitChangeList,  1,  Arity,  Index,  Newlndex)  . 

form_updated_index ( ( (ArgNo, Arg) IT) , InitArg, Arity, Index, Newlndex) 

NewArgNo  is  InitArg  *  1, 

(  InitArg  =\=  ArgNo  -> 

arg  ( InitArg, Index, ArgVa 1 )  , 
arg  ( InitArg,  Newlndex,  ArgVa  1)  , 

form_updated_ index ( [ (ArgNo, Arg) IT), NewArgNo, Arity, Index, 
Newlndex) 

;  /*  otherwise  ->  */ 

arg ( InitArg, Newlndex, Arg) , 

form_updated_ index (T, NewArgNo, Arity, Index,  Newlndex) 

)  . 

form_updated_index ( f  J , InitArg, Arity, Index, Newlndex) 

(  InitArg  =<  Arity  -> 

arg (InitArg, Index, ArgVa 1 )  , 
arg ( InitArg, Newlndex, ArgVa 1) , 

NewArgNo  is  InitArg  +  1, 

form_updated_index ( [ I , NewArgNo, Arity,  Index,  Newlndex) 

;  /*  otherwise  ->  */ 


add_e lement (List , E, NewList )  List  =  [EINewListj. 


tp»18 


J 


tp 


*%%%%%%%%»%%%%»%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
%%%  %%% 

%%%  Status  Messages  %%% 

%%%  %%% 

%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%% %%%%%%% %%%%%%%%%%*%%%%%%%%»%%%%%%%%% 


wr ite_subsumed_mesg ( Id, Subld) 

writelist  (  [clause,  Subld,  subsumes,  Id] )  , 
nl . 


wrice_added_mesg (Id, clause (Parents,  Pos,  Neg)  ) 
write list( [' added’ , Id, Parents]), 
con vert_to_external_ form (Pos,  Neg)  , 
nl . 
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boys . ax 


-pO  ;  -pi  ;  p2 . 

-p4  ;  -plO  ;  pl2. 

-pl7  ;  pl8  ;  pl9. 

-p2  ;  -p3  ;  plO. 

-p!7  ;  p4  ;  pl3. 

-p7  ;  -pll  ;  pl7. 

-p2  ;  -pl2  ;  -p4 . 

-pl8  ;  -pl3  ;  -plO. 

-pO  ;  pi  ;  -p7  ;  -pi7- 
-pO  ;  -p3  ;  pll. 

-P2  ;  -pi 9  ;  p4. 
pO  ;  pi . 
p2  ;  p3 . 
p4  ;  P7 - 
plO  ;  pll. 
pl2  ;  pl3. 
pi 7  ;  pl8. 
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boys . sos 


pO. 
p7  . 
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empty 


• 

ct_4 . sos 

po  ; 

pi  ;  p2.  -  # 

p3  ; 

p4  ;  p5. 

p6  ; 

P7  ;  p8. 

p9  ; 

plO  ;  pll. 

-pO 

-P3  • 

~pO 

-p6. 

-pO 

-p9. 

-p3 

-p6. 

-P3 

-P9.  • 

~p6 

-p9. 

-pi 

-p4  . 

-pi 

-pi . 

-pi 

-plO  . 

-p4 

-p7. 

“p4 

-plO  . 

-p7 

-plO  . 

-p2 

-P5.  # 

-p2 

-p8. 

-p2 

-pll. 

-p5 

-p8  . 

-p5 

-pll. 

-p8 

-PH. 

• 

• 

• 

• 

• 

• 
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□0  ;  pi  ;  p2  ;  p3 . 
p4  ;  p5  ;  p6  ;  p7. 
p8  ;  p9  ;  plO  ;  pll. 


pl2 

p  1 3  ;  p  1 4 

o  16 

pi 1  ;  pi 8 

-pO 

-p4  . 

-dO 

-p8  . 

-pO 

-pi2. 

-pO 

-pi  6 . 

-p4 

-p8  . 

-p4 

-pl2  . 

-p4 

-pi  6 . 

-p8 

-pl2. 

-p8 

-pi  6 . 

-p!2 

;  -pi 6. 

-pl  ; 

-pS  . 

-pi  ; 

-d9. 

“pl  ; 

-P13. 

-pl  ; 

-Pn. 

-p5  ; 

-p9. 

-p5  ; 

-P13. 

-p5  ; 

-d17  . 

-p9  ; 

-pl3. 

-p9  ; 

-pll. 

-p!3 

;  -pl7 

-p2  ; 

-p6. 

-d2  ; 

-plO. 

-d2  ; 

-p!4  . 

-d2  ; 

-pl8  . 

-p6  ; 

-plO. 

-p6  ; 

-pl4  . 

-p6  ; 

-pl8 . 

-plO 

;  -pl4 

-plO 

;  -pl8 

-p!4 

;  -pl8 

-p3  ; 

-pl  ■ 

-p3  ; 

-pll . 

-p3  ; 

-pis. 

-p3  ; 

-p!9. 

-p7  ; 

-pll. 

-p7  ; 

-P15. 

“P7  ; 

-pl9 . 

-pll 

;  -p!5 

-Dll 

;  -pl9 

-p!5 

;  -pl9 

pl5  . 
p!9. 


! 

• 

ct_6 . sos 

oC  ; 

ol  ;  d2  ;  p3  ;  o'  . 

• 

p5  ; 

oo  ;  p7  ;  p8  ; 

dIO  ; 

pll  ;  p  1 2  ;  p 1 3  ;  p!4. 

ol  5  ; 

p  1 6  ;  pl*7  ;  p!8  ;  p  1 9 . 

?2C  ; 

p2 1  ;  p22  ;  p23  ;  p24. 

d2  5  ; 

c2 6  ;  p27  ;  p28  ;  p29. 

-dO  , 

-p3  . 

-oO  ; 

-pl5 . 

• 

-pQ  ; 

-p20  . 

-pC  ; 

-p25  . 

-p5  ; 

-plO . 

-o5  ; 

-d!  b  . 

-p 5  ; 

-p2C  . 

- p5  ; 

-□23 . 

-o  1 J 

-□15  . 

-o  1 C 

-o20. 

• 

-plO 

-p23  . 

-ol  5 

-p2 0 . 

-d  1 5 

-p2  b  . 

-?2  0 

-p2 5  . 

-pi  ; 

-d6  . 

-pi  ; 

-pl  1 . 

-  d  *.  ; 

-□1 6  . 

-pi  ; 

-□21  . 

• 

-pi  ; 

-p2  6 . 

-d6  ; 

-pll- 

-d6  ; 

-pl 6 . 

-06  ; 

-□2  1 . 

-?6  ; 

-p2  6  . 

-oil 

;  -  d  1 6  . 

-pi  1 

;  -d2  1  . 

-pi  1 

;  -p26. 

• 

-pi  6 

;  -o21. 

—  □16 

;  -o26. 

-p21 

;  -p26. 

-p2 

-p7. 

-p2 

-  p  1 2  . 

-d2 

-  □  1 7  . 

-p2 

-P22. 

-p2 
-p  7 

-P27. 

-p!2  . 

• 

-□7 

-Pl7- 

-p7 

-p22. 

-p7 

-p27. 

-pi  2 

;  -oil . 

-pl  2 

;  -P22. 

-pi  2 

/  -P27. 

-p  1  7 

;  -P22. 

• 

-pl7 

;  -p27. 

-p22 

;  -p27. 

-p3 

-d8  . 

-p3 

-p  1 3  . 

-p3 

-pl 8  . 

-d3 

-P23. 

-p3 

-p28 . 

-p8 

-Pll  • 

-p8 

-pl8  . 

• 

-p8 

-P2  3  . 

-p8 

-p28  . 

-P 13 

;  -  p  1 8  . 

-pl3 

;  -p23. 

-Pl  3 

;  -p28. 

-p  1  8 

;  -P23. 

-pl8 

;  -p28 . 

-p2  3 

;  -p28 . 

• 
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boys .bench 


*  /* 

sec-up . boys :  bench  set-up  for  (tp)  boys 
*/ 

boys  :-  driver (boys)  . 
benchmark (boys, 

(do ( ' examples/boys . ax' , ' examples/boys . sos' ) ,  ! ) , 

(dummy  ('  examples/boys  .ax'  ,  'examples/boys  .  sos' )  ,  ! )  , 

1)  . 


show  (boys)  :-  asserc (show) , 

do  ('  examples /boys  .ax'  ,  '  examples /boy  s  .sos'), 
retract (show) . 


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*%%%%%%%%%% 
%%%  %%% 

%%%  Execution  t ime' measurement  code  $%% 

%%%  %%% 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 


♦include  "driver" 
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ct  2. bench 


*  /* 

9  set-up. ct_2:  bench  set-up  for 

*/ 

ct  2  : -  driver(ct  2). 


(tp)  ct_2 


benchmark  (ct_2, 

(do { '  examples /empty' , ' example s/ct_2 .sos' ) ,  !  )  , 

(dummy (' examples/empty' , ' examples/ct_2 . sos'  )  ,  ! )  , 

50)  . 


show(ct  2) 


assert (show) , 

do (' examples/empty' , ' examples/ct_2 . sos'  )  ,  ! , 

retract ( show) . 


%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
%%%  %%% 

%%%  Execution  time  measurement  code  %%% 

%%%  %*% 

%%%%%%%%%%% %%%%%%»%%%%%%%%%%%%%%%%%%%%%%%%%%t%%4%%»%%%%%%%%%%%%%%%% 


# include 


"driver" 
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ct  3 . bench 


*  /* 

set-up. ct_3  :  bench  set-up  for 

*/ 

ct  3  :-  driver (ct  3)  . 


(tp)  ct_3 


benchmark (ct_3, 

(do  ('  examples/empty'  ,  '  examples/ct_3  .  sos'  )  ,  ! )  , 

(dummy  ('  examples /empty'  ,  '  exampies/ct_3  .  sos'  ) ,  ! )  , 

15)  . 


snow(ct_3)  :-  assert (show)  , 

do ( ' examples /empty’ , ' examp les/ct_3 .sos'  ) , 
retract  (show)  . 


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
%%%  %%% 

%%%  Execution  time  measurement  code  %%% 

%%%  %%% 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*%%%%%%%%%%%%%%%%%%% 

♦include  "driver" 
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ct  4 . bench 


*  /* 

set-up. ct_4  :  bench  set-up  for  (tp)  ct_4 
*/ 

ct  4  :-  driver (ct_4) . 
benchmark.  (ct_4 , 

(do  ( '  examples/empty'  ,  '  exampl.es/ct_4  .  sos'  )  ,  ! )  , 

(dummy  ('examples/empty'  ,  '  examples/ct_4  .  sos'  )  ,  ! )  , 

1). 


show(ct_4)  :-  assert  (show) , 

do ( '  examples/empty' ,  '  examples/ ct_4 .sos'),  ! , 

retract (show) . 


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%% 
%%% 

%%%  Execution  time  measurement  code  %%% 

%%% 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%% %%%%% %%%%%%%%%%%%%%%%%%%%% 


♦include  "driver 


ct  5 . bench 


#  /* 

sec-up. ct_5  :  bench  set-up  for  (tp)  ct_5 

V 

ct_S  driver (cc_5) . 
benchmark (ct_5, 

(do ( '  examples /empty' , ' example s/ct_5 . so s' ) ,  ! ) , 

(dummy  ('  examples/empty'  ,  '  examples/ct_5  .sos'l,  ! )  , 
1)  - 


show(ct_5)  assert  (show) , 

do ( '  examples /empty' , ' examp les/ct_5 .sos'l,  ! 
ret  ract ( show)  . 


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%»%%%%%%%%%%%%%%% 
%%%  %%% 

%%%  Execution  time  measurement  coae  %%% 

%%%  %%% 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%»%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 


. ct  6. bench 


#  /* 

set-up. ct_6:  bench  set-up  for  (tp)  ct_6 

*/ 

ct_6  :-  driver (ct_6) . 
benchmark (ct_6, 

(do  ('  examples/ empty'  ,  '  examples/ct_6 .  so  s'  )  ,  ! )  , 

(dummy  ('  examples  /empty'  ,  '  examples/ct_6  .sos'l,  ! )  , 
1)  - 

• 

show(ct_6)  assert  (show) , 

do (' examples /empty' , ' examples/ct_6 .sos' ) ,  ! , 

retract {show) . 
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[C]  README 


ip  (C  version) 

Ross  Overbeek 
(312)  972-7856 
overbeek9anl-mcs .arpa 

This  directory  (tp/c)  contains  the  C  ver¬ 
sion  of  the  propositional  theorem  prover. 

To  make  it  on  a  new  machine,  do 

touch  *.c 
make  tp 

Once  the  make  completes,  do 

tp  <  . . /examples/boys . in  >  boys. out 
diff  boys. out  .. /examples/boys. out -verify 

to  get  output  and  verify  that  it  is  correct  . 

The  execution  should  take  only  a  few  seconds. 
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[c]  alloc. c 


# include  "tp.h" 

init_formula_db (db) 
struct  formula_db  *db; 

( 

int  usable_sz,  sos_sz,  i; 

db->next_avl  =  db->formula_storage  +  1; 
db->end_avl  =  db->formula_storage  +  MAX_CLAUSES; 

/*  get  storage  for  list  of  usable  formulas  */ 

usable_sz  =  NUM_CLASH_ENTRIES  *  sizeof  (struct  formula  *); 
db->usable . first  =  (struct  formula  **)  malloc (usable_sz) ; 
if  (db->usable . first  ==  NULL) 

( 

printf  ("malloc  for  usable  list  failed  in  masterin'"); 
exit  (1)  ; 

) 

* (db->usable . f irst )  =  NULL; 
db->usable . next_avl  =  db->usable. first; 

db->usable .end_avl  =  db->usable .  first  +  NUM_CLASH  ENTRIES; 


/*  get  storage  for  list  of  sos  formulas  */ 
/*  number  of  bytes  in  the  sos  list:  */ 
/*  2  *  maxvar  for  1  lit  formulas  •/ 
I*  maxvar  *  maxvar  for  2  lit  formulas  */ 
/*  2000  entries  each  for  3-6  lit  formulas  */ 


/*  50C  entries  each  for  0-64  lit  formulas  */ 

for  ( i =0 ;  i  <  MAXVAR;  i++) 

{ 

if  (i  -=  0)  /*  formulas  with  1  lit  */ 

sos  sz  =  2  *  MAXVAR; 
else  if~(i  -=  1) 

sos_sz  =  2  *  MAXVAR  *  MAXVAR; 
else  if  (i  ==  2) 
sos_sz  =  8000; 

else 

sos__sz  =  500; 

db->by_weight_in_sos [ i ]. first  = 

(struct  formula  **)  malloc (sos_sz  *  sizeof (struct  formula  *)) 
if  (db->by_weight_in  sos(i). first  ==  NULL) 

( 

printf  ("malloc  for  by_wt_in_sos  list  failed  in  masterin'1); 
exit  (1)  ; 

) 

* (db->by_weight_in_sos [ i ] . first)  =  NULL; 
db->by_weight_in_sos (i J .next_avl  = 

db->by_weight_in_sos ( i] .first; 
db->by_weight_in_sos [ i ) ,end_avl  = 

db->by_weight_in_sos ( i] . first  +  sos_sz; 

) 

/*  get  storage  for  subsumption  and  usable  indices  */ 

a  1 loc_index (S (db->sub_index) , NUM_SUB_IDX_ENTRIES) ; 
al loc_ index ( & (db->ciash_index) , NUM_CLASH  IDX  ENTRIES); 
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[c]  alloc. c 


ailoc_index (idx, nura_encries) 
struct  cl_index  *idx; 
int  num_entries; 

( 

int  i; 

for  ( i =0 ;  i  <  MAXVAR;  i++) 

< 

idx->pos_lits [ i ]. first  = 

(struct  formula  **)  mal loc (num_entries  *  sizeof  (struct  formula  *) ) ; 
if  (idx->pos  lit s [ i ]. first  ==  NULL) 


f 


print f ("malice  for  idx  list  failed  in  masterin''); 
exit  (1)  ; 


* ( idx->pos_lits [ i] . first)  =  NULL; 

idx->pos_lits ( i ] . next_avl  =  idx->pos_l it s [ i ] . f irst ; 
idx->pcs_iits ( i ] ,end_avl  =  idx->pos  Lits ( i] . first  +  num_entries; 

idx->neg_lits [i ]. first  = 

(struct  formula  **)  malioc (num_entries  *  sizeof (struct  formula  *) ) ; 
if  (idx->neg  lits (ij . first  -»  NULL) 

{ 

printf  ("malioc  for  idx  list  failed  in  masterin'*); 
exit (1) ; 

) 

* ( idx->neg_l it s ( i ] . f i rst )  =  NULL; 

i dx->neg_l i t s ( i ] . next_avl  =  idx->neg_lits [ i ], first; 

idx->neg_l it s ( i ] .end_avl  =  idx->neg_lit s [ i ] . f irst  +  num_entries; 
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[c]  c. macros 


♦define  TestBit (Bitvec, Var)  (  (Bitvec) ->wordl  &  (1  <<  (Var))). 

♦define  Numlits  (C)  (count_bits ( (C) ->positive .wordl)  + 
count _b it s ((C) ->negative .wordl ) ) 

♦define  CopyBitvec  (From,  To)  To  =  From; 

♦define  Subsumes (Cl , C2 ) 

((( (Cl) ->positive . wordl  &  (C2) ->positive. wordl)  ==  (Cl) ->posit ive . wordl )  SS 

(( (Cl) ->negat ive . wordl  &  (C2 ) ->negat ive .wordl)  ==  (Cl) ->negat ive . wordl ) ) 


♦define  MakeResol vent (Cl, C2, V, R) 

(R)  .parents  [0]  =  (Cl)  — > id ; 

(R) .parents [1]  =  (C2)->id; 

(R) .positive .wordl  = 

( (Cl) ->positive. wordl  I  (C2) ->posit ive . wordl)  '  (1  <<  (V)); 
(R) .negative .wordl  = 

(  (Cl) ->negat ive .wordl  I  (C2) ->negative .wordl)  '  (1  <<  (V) ) ; 

♦define  Printcls(C) 

f 

printf  ("%d  (%d,%d]  ",  (C)->id,  (C) ->parents  [0) ,  (C) ->parents  [  11  )  ; 
print_clause (s ( (C) ->posicive) , S  l  (C) ->negative) ) ; 
printf  ; 
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[c]  clocks. c 


♦include  "tp.h" 

♦include  <sys/time.h> 

♦include  <sys/ resource . h> 

struct  clock  ( 

int  accum_sec;  /*  accumulated  seconds  */ 
int  accum_usec;  /*  accumulated  microseconds'/ 
int  curr_sec; 
int  curr_usec; 

>  ; 


struct  clock  clocks [MAX_CLOCKS] ; 

/******»•»**#** 

'  clock_init()  -  Initialize  all  clocks. 

* 

*************  j 

clock_init  () 

( 

int  i; 

for  { i=0 ;  i<MAX_CLOCKS;  i++) 
clock_reset (i)  ; 

}  /*  clock__init  */ 

/************* 

* 

*  cpu_t ime ( sec,  usee)  -  It  has  been  sec  seconds  +  usee  microseconds 

*  since  the  start  of  this  process. 


*************  f 

cpu_t ime ( seconds,  microseconds) 
int  'seconds,  'microseconds; 
f 

struct  rusage  r; 

getrusage(0,  Sr); 

'seconds  =  r . ru_ut ime . t v_sec; 
'microseconds  =  r . ru_ut ime . t v_usec; 
)  /*  cpu_time  '/ 


/***"*"*"" 

* 

*  clock_start (clock_num)  -  Start  or  continue  timing. 

*  If  the  clock  is  already  running,  a  warning  message  is  printed. 

* 

*************  j 

clock_start (c) 
int  c; 

( 

struct  clock  *cp; 

cp  =  Sclocks [c] ; 
if  (cp->curr_sec  !=  -1)  { 

fprintf (stderr,  "WARNING,  clock_start:  clock  %d  already  on.\n",  c) ; 
printf ("WARNING,  clock_start:  clock  %d  already  on.\n",  c)  ; 

) 

else 

cpu_time (Scp->curr_sec,  Scp->curr_usec) ; 

)  /*  clock  start  */ 
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[c]  clocks. c 


/ 


*  *  *  * 


*  clock_stop (clock_num)  -  Stop  timing  and  add  to  accumulated  total. 

*  If  the  clock  not  running,  a  warning  message  is  printed. 

nr*  ***********/ 


clock_st op (c) 

{ 

int  sec,  usee; 
struct  clock  *cp; 

cp  =  Sclocks [ c ] ; 
if  (cp->curr__sec  ==  - 1 )  { 

fprintf  (stderr,  "WARNING,  clock_stop:  clock  %d  already  on.\n",  c) 
print f ( "WARNING,  clock_stop:  clock  %d  already  on.\n”,  c) ; 

} 

else  { 

cpu_t ime (Ssec,  & usee); 
cp->accum_sec  sec  -  cp->curr_sec; 
cp->accum__usec  +=  usee  -  cp->curr_usec; 
cp->curr__sec  =  -1; 
cp->currjjsec  =  -1; 

) 

}  /*  clock_stop  */ 

/*********«**  * 


*  int  clock_val (clock_num)  -  Returns  accumulated  time  in  milliseconds 

* 

*  Clock  need  not  be  stopped. 

* 

w ************/ 


int  clock_val(c) 
int  c  ; 

( 

int  i,  j,  sec,  usee; 

i  =  (clocks  ( c ]  .accum_sec  *  1000)  *  (clocks [c] .accum_usec  /  1000); 
if  (clocks [c] .curr_sec  ==  -1) 
return  ( i)  ; 
else  ( 

cpu_t ime (Ssec,  Susecl  ; 

j  =  ((sec  -  clocks [ c ). cur r_sec)  *  1000)  ♦ 

((usee  -  clocks [c] .curr_usec)  /  1000); 
return  (  i  + j)  ; 

) 

!  /*  clock_val  */ 

/  ******■**★».*. 


clock_reset (clock  nun) 


Clocks  must  be  reset  before  being  used. 


*************/ 


clock_reset  (c) 
int  c; 

{ 

clocks  [c]  . accum_sec  =  clocks [c]  .accum_usec  =  0; 
clocks [ c ]. curr_sec  =  clocks (c] .curr_usec  =  -1; 

}  /*  clock  reset  */ 
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[c]  db.c 


*inciude  "tp.h" 

a  da_c  o_sos (db, ptr_ formula) 
struct  formula_db  *db; 
struct  formula  *ptr_formula; 

int  pos_int s (MAXVARj ,  neg_ints [ MAXVAR j ; 
struct  formula  *cls; 
struct  list  *lst; 

/* 

if  usable  formulas  storage  is  exhausted  then  simply  terminate 
the  program 
*/ 

if  (  db->next_avl  >  db->ena_avi) 

printf("\n\n  Usable  Formula  Area  Overflow  \n\n"); 
exi.  { 1 ) ; 

/* 

place  the  usable  formula  at  the  next  available  position, 
as  pointed  to  by  the  nextavl  pointer,  in  the  formula 
storage 

*/ 

els  =  db->next_avi ♦  >; 

/*  generate  formula  id  */ 

cis->id  =  (els  -  db->formuia_storage) ; 

cis->parents [0]  =  pt r_formuia->parent s ( 0 ] ; 
cls->parents [ 1 ]  *  pt r_f ormuia->parent s [ 1 ] ; 

CopyBitvec (pt r_f ormu la->pos it ive .wordl, cls->posit i ve .wordl) ; 
CopyBitvec (pt r_ formula ->negat ive .wordl, ci s->negat ive .wordl) ; 


get  pointer  to  the  array  entry  by_weight_in_sos,  in 
whose  list  this  particular  formula  is  to  be  placed 

*/ 

1st  =  db->by_we ight_in_sos  ♦  (Numl its (els)  -  1); 
add_to_list ( 1st , els) ; 

add_to_ index (4 (db->sub_ index)  ,  els)  ; 
return (cls->id) ; 

i 

move_to_usable (db,  id)  /*  mv  els  from  so s  to  usable  */ 

struct  formula_db  *db; 
l n  t  id; 

struct  formula  *c; 

int  .num_iits,  pos_int  s  (MAXVAR  ] ,  neg_  mt  s  :  MAXVAR  j  ; 


c  =  db->f ormu la_storage  +  id; 

i f  (de l_f  rom_l 1st (4 (db->by_weight_in_sosi Numl its(c)-l]),c)) 

{ 

add_to_l ist (4  (db->usable) , c) ; 
add_to_index (4 (db->cia sh_ index) , c) ; 

i 

else 

printf  (*'***  mv_cmd:  invalid  move  of  cl  %d\n",id); 
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delete _from_dat abase (db, id) 
struct  formula_db  *db; 
int  id; 


struct  formula  *c; 


c  =  db->formula_storage  +  id; 
if  (de l_f rom_list {4 (db->usable) ,c)  ) 

aei_f rom_index (4 (db->clash_index) , c) ; 

else 


del 


ael_f rom_iist (4 (db->by_weight_in_sos (Numlits (c) -1] ) , c) ; 
from  index <4 (ab~>sub_ index) , c) ; 


int  count^bit s ( v) 
register  unsigned  int  v; 

register  int  i; 
register  unsigned  int  j; 


return (i) 


j; 


add_to_index (ndx, cl) 
struct  ci^index  *ndx; 
struct  formula  *cl; 

{ 


int  pos_ int  s ( MAXVAR  ] , 
int  p,n,  i; 


neg_i n t s f  MAXVAH  J ; 


/* 


adds  the  formula  to  the  list  of  formulas, 
each  literal  (  +ve  or  -ve  ) 

lit_nums (4 (cl->posit ive) , pos_ints) ; 

1 i t_nums (4 (cl->negat ive) , neg_ints) ; 


maintained  for 


/*  add  formula  to  sub_index  for  each  lit  represented  */ 


for  (  i  =  0 ;  i  <  p;  i++) 

add_to_l ist ( & (ndx->po splits [pos_ints ( i ) ] ) , cl) ; 


for 


(  i  =  0 ;  i  <  n;  i4--*-) 

add _to_i ist (4 (ndx->neg_I i t s (neg_ints [ i ] ) ) 


ci)  ; 


i  it _r. urns  (bits,  int s ) 
3IT7EC  *  b i t  s ; 
i r.t  *  int  s ; 


count 
*n  i  = 


=  ^  i 
int  s; 
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/* 

Returns  the  number  of  +ve  or  -ve  literals  in  the  formula. 

It  also  places  in  the  array  ints  tho  entry  of  which  literal 
(  out  of  all  those  available  )  occured  in  a  formula 


for  C i = 0 ;  i  <  MAXVAR;  i  +  +  ) 
if  (TestBit  (bits, i) ) 

( 

count"; 

*  ( n  i  +  + )  =  i; 

} 

return (count)  ; 

) 

add_to_list  (alist, aformula) 
struct  list  'alist; 
struct  formula  'aformula; 

( 

struct  formula  "p,  "pl,"p2; 
int  i; 

if  (alist->next_avl  >=  alist->end_avl) 

( 

i  =  (alist->next_avl  -  al ist-> f irst )  *  2; 

p  =  (struct  formula  ")  malloc(i  ’  s izeof  (st ruct  formula  ')); 
if  (  !p) 

( 

printfC’"  failure  to  allocate  in  add_to_list:  aborting\n”)  ; 

exit ( 1 ) ; 

) 

for  (pl=al ist->f irst , p2=p;  pi  <  alist->next_avl; ) 

'  (p2  +  +  )  =  *  (pl  +  +  )  ; 

free (alist ->first) ; 
alist->first  »  p; 
alist->next_avl  =  p2; 
alist->end_avl  =  p  +  i; 

) 

* (alist->next_avl)  =  aformula; 

(; list->next_avl ) ++; 

} 

del_f  rom_index  (ndx,  cl) 
struct  cl_index  *ndx; 
struct  formula  'cl; 

( 

int  pos  ints [MAXVAR] ,  neg_ints [MAXVAR] ; 
int  p , n , i  ; 

p  lit_nums (« (cl->positive) , pos_ints) ; 
n  =  1 it_nums (S (cl->negat ive) , neg_ints) ; 

for  ( i  =  0 ;  i  <  p;  i++) 

de l_f rom_list (s (ndx->pos_l it s [pos_ints [ i ] j ) , cl) ; 
for  ( i=0;  i  <  n;  i  +  +  ) 

del_f rom_list (s (ndx->neg_lits [neg_int s [ i ] ] ) , cl) ; 

> 
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del_f rom_list (alist, aformula) 
struct  list  *alist; 
struct  formula  *aformula; 

{ 

int  rc; 

struct  formula  **c; 


for  (c=alist->f Irst ;  c  <  alist->next_avl  &&  *c  !=  aformula;  c+  +  ) 


if  (*c  ==  aformula) 

{ 

(alist->next_avl) — ; 
while  (c  <  alist->next_avl) 
{ 

*c  *  *  (c  +  1)  ; 

C++; 

} 

rc  =  TRUE; 

} 

else 

rc  =  FALSE; 
return (rc) ; 

} 


tp  «44 


[c]  io.c 


♦include  "tp.h" 

♦define  POS  1 
♦define  NEG  2 

char  symtab [MAXVAR] [MAX_SYMBOL_LEN] ; 
static  next_var  =  0; 

char  *get_word(),  *skip_white  ( ) ; 

read_input (db) 
struct  formula_db  "db; 

{ 

int  new_formula; 

char  axm_file (STRINGLEN] ,  sos_file (STRINGLEN] ; 

FILE  "af,  *sf; 
struct  formula  clause; 

3ITVEC  pos,  neg; 

printf  ("Ep.Ler  axm  filename  ;  "); 
scanf ("is", axm_file) ; 
printf  (“\n") ; 

if  ( (af  =  fopen (axm_f ile, " r" ) )  ==  NULL) 

i 

fprintf (stderr, "Error  opening  axiom  file  %s:  ",axm_fiie); 
pe  r  ro  r  ( "  “ )  ; 
exit  (1)  ; 

> 

printf ("Enter  sos  filename  :  "); 
scanf ("%s", sos_file) ; 
printf  ("Vn")  ; 

if  (  (sf  =  fopen (sos_file, " r") )  ==  NULL) 

( 

fprintf (stderr, "Error  opening  sos  file  %s:  " , sos_f i le) ; 
perror  ("" ) ; 
exit (1) ; 

) 

clause. parents (0)  =  -1; 
clause . parents [ 1 ]  =  -1; 

while  (read_literals (af, S (clause .positive) , S (clause .negative) ) ) 

( 

new_formula  =  add_to_sos(db,Sclause); 
printf ("added  ; 

Printcls (db->formula_storage+new_formula) 
move  to_usable (db, new_formula) ; 

) 

while (read_l icerals (s f, S (clause . pos it ive) , S (clause . negative) ) ) 
( 

new_forroula  =  add_to_sos (db, Sclause) ; 
printf ("added  "); 

Printcls  (db->formula_storage+new_formula) 

) 

i 

BOOL  read_l iterals ( fp, pos, neg) 

FILE  *fp; 

BITVEC  *pos,  *neg; 

( 

int  i,  vnum,  vat,  sign; 

char  *bptr,  buf (MAXVAR  *  (MAX_SYMBOL_LEN  +  10)1; 
char  word (MAX_SVMBOL_LEN J ; 
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if  (next_var  ==  0)  /*  first 

for  (i  =0;  i  <  MAX VAR;  i++) 
symtab[i]  [0]  =  ' \0'  ; 

pos->wordl  =  neg->wordl  =  0; 
bptr  =  buf; 

while  (((*bptr  =  getc(fp))  !=  SS  (*bptr 

if  <*bptr  ! =  ' \n' ) 
bptr++; 

if  (*bptr  ==  EOF) 
return  FALSE; 

•bptr  =  ' \0' ; 

bptr  =  buf; 
while  (»bptr) 

{ 

bptr  =  get_word (bptr, word, ssign) ; 
var  =  f  ind_word_in__symtab  (word)  ; 

if  (sign  ==  POS) 

pos->wordl  1=  1  <<  var; 

else 

neg->wordl  1=  1  <<  var; 

) 

return  TRUE; 

} 

char  *get_word (bptr, word, sign) 
char  *bptr,  "word; 
int  ‘sign; 

{ 


'sign  =  POS; 

bptr  =  skip_white (bptr) ; 

if  (*bptr  ==  '-') 

{ 

•sign  =  NEG; 
bpt  r  +  +  ; 

} 

bptr  =  skip_white (bptr) ; 
while  ("bptr  ss  (*bptr  !=  '  ')) 
( 

*word++  =  *bptr++; 

) 


•word  =  '  \0'  ; 
if  (»bptr) 

( 

bptr  =  skip_white (bptr) ; 

if  ((*bptr  ==';')  II  (*bptr 
bptr++; 

else 

( 

fprintf  (stderr,  "Syntax  error\n"); 
return  FALSE; 

) 

) 

return  skip_white (bptr)  ; 


call  */ 


!  =  EOF) ) 
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char  ’skip_white  (ptr) 
char  *ptr; 

{ 

while  Cptr  ii  (*ptr  ==  '  ')  I  I  Cptr  ==  '  ')) 

pt  r  +  +  ; 

return  ptr; 

} 

int  f ind_word_in_symtab (word) 
char  'word; 

{ 

register  int  i; 

for  (i  =  0;  i  <  next_var;  i++) 

if  (strcmp (syratab [ i ] , word)  =*  0) 
return  i; 

if  (next_var  <  MAXVAR  -  1) 

( 

strcpy (symtab [next_var]  ,  word)  ; 
return (next_var++) ; 

) 

else 

{ 

fprintf (stderr, "Too  many  variablesXn") ; 
exit  (1)  ; 

) 

) 

print_clause (pos, neg) 

BITVEC  *pos,  *neg; 

( 

int  i; 

unsigned  int  negword  =  neg->wordl,  posword  =  pos->wordl; 

for  (i  =  0;  i  <  MAXVAR;  i++) 

( 

if  (posword  t  1) 

( 

posword  >>=  1; 
printf("%s  ", symtab [i] ) ; 
if  (posword  I  I  negword) 
print  f  Cl  " )  ; 

} 

else 

posword  >>=  1; 

) 

for  (i  =  0;  i  <  MAXVAR;  i++) 

( 

if  (negword  &  1) 

( 

negword  >>=  1; 
printf("-%s  ", symtab [ i] ) ; 
if  (negword) 

printf ("I  ") ; 

} 

else 

negword  >>=  1; 

> 

I 
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CFLAGS  =  -g 

TP  FILES  *  tp.o  subsump. o  db.o  alloc. o  io.o  clocks. 

tp  :  $<TP_FILES) 

cc  5 (CFLAGS)  -o  tp  S (TP_FILES) 


[c]  subsump. c 


♦include  "tp.h" 

forward_sub (db,  res) 
struct  formula_db  *db; 
struct  formula  *res; 

{ 

int  pos_lits [  MAXVAR J , neg_lits [MAXVAR]  ; 
struct  formula  **pt; 
struct  list  *lst; 
int  p,  n,  i, *nl; 

BOOL  subsumed  =  FALSE; 
int  subsumer; 

p  =  lit_nums (4res->posit ive,  pos_lits) ; 

for  (i  =  0,nl  =  pos_lits;  '.subsumed  44  (i  <  p)  ;  i  ++,nl++) 

( 

1st  =  4 (db->sub_index.pos_lits [ *nl ] )  ; 

for  (pt  -  lst->first;  '.subsumed  44  (pt  <  lst->next_avl) ;  pt  +  +  ) 
if  (Subsumes (( *pt ), res) ) 

( 

subsumed  =  TRUE; 
subsumer  -  (*pt)->id; 

) 

) 

if  ((subsumed) 

{ 

n  =  lit_nums (4res->negative,  neg_lits)  ; 

for  (i  =0,  nl  =  neg_lits;  (subsumed  44  (i  <  n) ;  i++,  nl++) 

( 

1st  -  4 (db->sub_index.neg_lits [*nl] )  ; 

for  (pt  =  lst~>£Lcst;  .'subsumed  a  (pt  <  lst->next_avl) ;  pt  +  +  ) 

t 

if  (Subsumes ( (*pt) , res) ) 

( 

subsumed  =  TRUE; 
subsumer  =  (*pt)->id; 

) 

) 

> 

) 


return (subsumed  ?  subsumer  :  -1); 

) 

back_sub (db, formula_id) 
int  formula_id; 
struct  formula_db  *db; 

( 

int  lits (MAXVAR] ; 
struct  formula  **pt; 
struct  list  *lst; 
int  p,  n,  i,  'ob¬ 
struct  formula  *cl; 

cl  =  db->formula_storage  +  formula_id; 

if  (p  =  lit_nums (4 (cl->positive) ,  lits)  ) 

1st  =  4 (db->sub_index.pos_lits (lits [0 IJ )  ; 

else 

( 

n  =  lit_nums (4 (cl->negat ive) , lits) ; 

1st  =  4 (db->sub_index .neg_lits ( 1  its (0) J ) ; 

) 
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for  (pc  =  lst->next_avl  -  1;  pt  >=  lst->first;  pt--) 

( 

if  ((formula_id  !=  (*pt)->id)  Si  Subsumes (cl, (*pt) ) ) 

{ 

printf  ("clause  %d  subsumes  %d  \n",  f ormula_id,  ( *pt ) — >id) 
add_to_deleted_list ( (*pt) ->id) ; 

} 

) 

) 

static  int  clauses_to_delete ( 10000 ] ; 
static  int  next_to_delete  =  0; 

add_to_deleted_list (id) 
int  id; 

{ 

register  int  i; 

for  (i  =  0;  i  <  next_to_de lete  &£  clauses  to_delete[i]  !=  id;  i+ 


if  (i  ==  next_to_delete) 

clauses_to_delete [next_to_delete++]  =  id; 

) 

delete_saved_clauses (db) 
struct  formula_db  *db; 

( 

int  i; 

for  (i  =  0;  i  <  next_to_delete;  i++) 

delete_f rom_database (db, clauses_to_delete  [  i ] ) ; 

next_to_delete  =  0; 

} 
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((include  "tp.h” 

struct  formula_db  master_db; 

main  ( ) 

{ 

BOOL  proof_completed; 
clock_init ( ) ; 

init_formula_db (&master_db) ; 
read_input (&master_db)  ; 

clock_start (CLK_RUNTIME)  ; 
proof_completed  =  generate (Smaster_db) ; 
clock_stop (CLK_RONTIME)  ; 

if  (proof_completed) 

printf  ("Proof  foundin''); 

else 

printf  ("Proof  not  foundin''); 

printf  ("Total  time  is  %f  secin" , ( f loat ) clock_val (CLK_RUNTIME)  /  1000.0); 

) 

300L  generate (db) 
struct  formula_db  *db; 

( 

BOOL  proof_completed  =  FALSE; 
int  given; 

while  (((given  =  pick_given  formula(db))  !=  -1)  is  ! proof_completed) 

( 

printf ("given  %din", given) ; 
move_to_usable (db, given) ; 

proof  completed  =  gen_from_given (db, given) ; 

) 

return  proof_completed; 

) 

BOOL  gen_from_given (db, given) 
struct  formula_db  *db; 
int  given; 

( 

struct  formula  *cl,  c2; 
int  p,  n; 
int  *nl,  i; 
struct  list  *lst; 
struct  formula  **pt; 

int  pos_lits [MAXVAR] ,  neg_lits (MAXVARJ ; 

BOOL  proof_completed  =  FALSE; 

cl  =  db->formula_storage  +  given; 

p  =  lit_nums (S (cl->positive) , pos_lits)  ; 
n  =  lit_nums (S (cl->negat ive) , neg_lits) ; 

for  (i  ■  0,  nl  »  pos_lits;  (i  <  p)  ti  !proof_completed;  i++,  nl++) 

( 

Lst  =  S (db->clash_index.neg_l its ( *nl ] ) ; 

for  (pt  =  lst~>next_avl  -  1;  (pt>= lst-> f i rst )  ss  ! proof_completed;  pt — ) 

proof _comp  leted  =  gen_one_reso 1  vent (db, cl , *pt , *n 1 ) ; 

delete_saved_clauses (db) ; 

I 

for  (i  ■  0,  nl  >  neg_lits;  (i  <  n)  ss  ! proof_completed;  i++,  nl++) 
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1st  =  s  (db->clash_index.pos_lits  (Ml) )  ; 

for  (pt  =lst->next_avl  -  1; (pt  >=  lst->first)  SS  ! proof _completed;  pt- 
proof_completed  =  gen_one_resolvent  (db,  cl,  *pt.  Ml)  ; 

delete  saved  clauses (db) ; 


return  proof_completed; 


BOOL  gen_one_resol vent (db, cl,  c2,  var) 
struct  formuia_db  Mb; 
struct  formula  "cl,  M2; 
int  var; 

( 

struct  formula  resolvent; 
int  id; 

MakeResolvent (cl,  c2,  var,  resolvent); 
if  (Numlits (Sresolvent)  ==  0) 


( 


printf ("derived  null  clause  from  %d  and  %d\n“ , resol vent . parents [ 0 ) , 
resolvent .parents [ 1] ) ; 
return  TRUE; 


if  (tautology (sresolvent )  ) 
return  FALSE; 

if  (forward  sub  (db, Sresolvent)  ==  -1) 


{ 


id  =  add_co_sos (db,  Sresolvent )  ; 
printf  ("added  ")  ; 

Printcls (db->formula_storage  +  id)  ; 
back  sub(db.id); 


return  FALSE; 

} 

BOOL  tautology (cl) 
struct  formula  Ml; 

( 

return  (cl->posit ive . wordl  S  cl->negat ive . wordl)  !=  0; 

} 

int  pick_given_formula (db) 
struct  formula_db  'db; 

( 

int  i ,  r e t  va 1 ; 

/*  returns  next  formula  from  set  of  support  */ 
for  (i=0; 

i  <=  MAX_WEIGH?  SS 

(db->by_weight_in_sos (i). first  =»  db->by_we ight_in_sos [ i] . next_avl) 

i  +  +  ) 


if  (i  <=  MAX_WEIGHT) 

retval  =  ( * (db->by_weight_in_sos | i i ,next_avl  -  1 ) ) — > id ; 

else 

retval  -  -1; 
retu  rn  ( ret  va  1 )  ; 
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♦include  <stdio.h> 


♦define  MAX_WLIGHT  31 

♦define  MAXVAR  32 

♦define  MAX_CLAUSES  20000 

♦define  NEW_CLAUSE  0 

♦define  MAX_SYMBOL_LEN  256 

♦define  STRINGLEN  50 

♦define  NUM_CLASH_ENTRIES  2000 

♦define  NUM  SUE  IDX  ENTRIES  2000 


♦define  NUM_CLASH_IDX_ENTRIES  2000 

♦define  MAX_CLOCKS  30 

♦define  CLK_RUNTIME  0 

typedef  int  BOOL; 

♦define  TRUE  1 
♦define  FALSE  0 

typedef  struct  {unsigned  int  wordl;  )  BITVEC; 

struct  formula  { 
int  id; 

int  parents [2]; 

BITVEC  positive; 


BITVEC  negative; 

}  ; 

struct  list  {  /*  one  entry  for  signed  prop,  variable  */ 

struct  formula  ** first ; 
struct  formula  **next_avl; 
struct  formula  *,rend_avl  ; 

>  ; 

struct  cl__index  { 

struct  list  pos_lits [MAXVAR] ; 
struct  list  neg_lits [MAXVAR]  ; 

)  ; 


struct  formula_db  ( 

struct  cl_index  sub_index;  /*  into  all  formulas  */ 

struct  cl_index  clash_index;  /*  into  clashable  formulas  */ 

struct  formula  formula_storage [MAX_CLAUSES  *  sizeof  (struct  formula)]; 
struct  formula  *next_avl;  /*  points  to  entry  in 

fcrmula_storage  (next  available 
formula  entry) 

*/ 

struct  formula  *end_avl;  /*  last  entry  in  formula_storage  */ 

struct  list  by_weight_in_sos (MAX_WEIGHT+1 ] ;  /*  set-of-support  */ 
struct  list  usable;  /*  usable  formulas  V 


)  ; 

♦include  "c. macros" 


/*  id  of  the  formula  */ 

/*  ids  of  parents  ([-1,-1]  for  input  formula)  */ 
/*  bits  set  to  reflect  positive  literals: 
rightmost  bit  represents  pO 

*/ 

/*  bits  set  to  represent  negative  literals  */ 


tp*53 


warren 


dividelO.m .  1 

loglO  .m .  2 

ops  8  .m .  3 

timeslO  .m .  4 

deriv .  5 

nreverse.m .  6 

qsort  .m .  7 

query. m .  9 

serialise  .m .  11 

.dividelO -bench .  13 

.loglO.  bench . 14 

. ops8  .bench  .  15 

.timeslO  .  16 

.  nreverse  .bench .  17 

.qsort.  bench .  18 

.query,  bench .  19 

. serialise .bench .  20 


dividelO .m 


♦  /* 

dividelO. m:  Warren  benchmark  (deriv)  dividelO  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  opt  ion (s)  :  S _ OPTIONS _ S 

% 

%  (deriv)  dividelO 

« 

%  David  H.  D.  Warren 
I 

%  symbolic  derivative  of  (((((((  (x/x) /x) /x) /x) /x) /x) /x) /x) /x 

♦  assign  DIVIDE10_EXP  (((((((  (x/x)  /x)  /x)  /x)  /x)  /x)  /x)  /x)  /x 

♦ 

♦if  BENCH 

♦  include  “ .dividelO .bench” 

♦  else 

♦option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/l." 

♦  if  SHOW 

dividelO  d (DIVIDE 10_EXP, x, D) , 

write  ('  (d/dx)  ('  )  , 
write (DIVIDE10_EXP) , 
write  ( ' )  =' ) ,  nl, 
write (D) ,  nl . 

♦  else 

dividelO  d (DIVIDE10 _EXP, x, _) . 

♦  endif 
♦endi f 

♦include  "deriv"  /*  code  for  symbolic  derivative  */ 
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♦  /» 

ioglO.m:  Warren  benchmark  (deriv)  loglO  master  file 

*/ 

%  generated:  _ MDAY _  _ MONTH _  _ YEAR _ _ 

%  option(s):  S _ OPTIONS _ S 

% 

%  (deriv)  loglO 
% 

%  David  H.  D.  Warren 
% 

%  symbolic  derivative  of  log ( log ( log ( log ( log ( log ( log ( log ( log ( log (x) )))))))) ) 

((assign  LOG10_EXP  log  ( log  ( log  ( log  ( log  ( log  ( log  (log  (log  ( log  (x)  I  )))))))  ) 

♦ 

if  if  BENCH 

♦  include  logic . bench" 

♦  else 

♦option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  dees.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

♦  if  SHOW 

loglO  d (LOG10_EXP, x, D) , 

write  ('  (d/dx)  ('  )  , 
write (LOG10_EXP) , 
write  ('  )  ='  )  ,  nl, 
write (D) ,  nl . 

if  else 

loglO  d  (LOG10_EXP, x, _) . 

if  endif 
♦endi f 

♦include  "deriv"  /*  code  for  symbolic  derivative  */ 
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*  /* 

ops8.m:  Warren  benchmark  (deriv)  ops8  master  file 
*/ 

%  generated: _ MDAY _ MONTH _ YEAR _ 

%  opt t  (s)  :  S _ OPTIONS _ $ 

% 

%  (deriv)  ops8 

% 

%  David  H.  D.  Warren 
% 

%  symbolic  derivative  of  (x+1) * ( ( " (x, 2) +2) *  ( “ (x, 3) +3) ) 

♦  assign  CPS8_EXP  (x+1 )  * ( (‘ (x, 2) +2) * (' (x, 3) +3) ) 

♦ 

# if  3ENCH 

♦  include  ".  ops8 . bench" 

♦  else 

♦option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

♦  if  SHOW 

ops8  a (0PS8_EXP, x, D) , 

write  ( '  (d/dx)  ( ' ) , 
write (0PS8_EXP) , 
write  (' )  =' ) ,  nl, 
write(D),  nl. 

♦  else 

ops8  d (0PS8_EXP, x,_) . 

♦  end if 
♦endif 

♦include  "deriv"  /*  code  for  symbolic  derivative  */ 


warren  *3 


timeslO  .m 


♦ 


% 

% 

% 

% 

% 

% 

% 

% 


/* 

timeslO.ra:  Warren  benchmark  (deriv)  timeslO  master  file 

*/ 

generated:  _ MDAY _ MONTH _  _ YEAR _ 

option (s) :  S _ OPTIONS _ S 

(deriv)  timeslO 

David  H.  D.  Warren 

symbolic  derivative  of  (((((((  (x*x)  *x)  *x)  *x)  *x)  *x)  *x)  *x)  *x 


♦  assign  TIMES10_EXP  (((((((  (x*x)  *x)  *x)  *x)  *x)  *x)  *x)  *x)  *x 

* 

♦if  BENCH 

It  include  "  .  timeslO  .bench" 

♦else 

♦option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 


♦ 

t 


if  SHOW 

imeslO  d (TIMES 10_EXP, x, D) , 
write  ('  (d/dx)  (' )  , 
write (TIMES10_EXP)  , 
write ( ' )  ='),  nl< 
write (D) ,  nl . 


♦  else 
timeslO 

♦  endif 
♦endif 


d(TIMES10_EXP,x,_)  . 


♦include  "deriv" 


/*  code  for  symbolic  derivative  */ 
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*  /* 

deriv:  Warren  code  for  symbolic  derivative 

*/ 

((option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (d/3)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
#if  DUMMY 

d  - 

#e  Ise 

d  CJ+V,  X,  DU+DV)  !, 

d  (U,  X,  DU) , 
d  ( V,  X,  DV)  . 

d(U-V,  X,  DU-DV)  !, 

d  (U,  X,  DU)  , 
d  (V,  X,  DV)  . 

d(U*V,X,  DU*V+U*DV)  !, 

d  (U,  X,  DU)  , 
d  (V,  X,  DV)  . 

d(U/V,X,  (DU*V-U*DV)  /  r  (V,  2)))  I, 
d  (U,  X, DU)  , 
d  (V,  X,  DV)  . 

d(*  (U,  N)  ,X,DU*NM"  (U,N1)  ))  \ 

integer (N) , 

N1  is  N-l, 
d  (U,  X,  DU)  . 
d(-U,X,-DU)  !, 

d  (U,  X,  DU)  . 

d  (exp  (U)  ,  X,  exp  ( U )  *  DU )  !, 

d(U,  X,  DU)  . 

d (log (U) , X, DU/U)  !, 
d (U,  X, DU)  . 
d  (X,  X,  1)  !. 

d  (_,  _,  0 )  . 

Kendif 
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♦  /* 

nreverse.m:  Warren  benchmark  nreverse  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s):  S _ OPTIONS _ $ 

% 

%  nreverse 
% 

%  David  H.  0.  Warren 
% 

%  "naive‘,-reverse  a  list  of  30  integers 
#if  BENCH 

#  include  " .nreverse. bench" 

♦else 

♦option  SHOW  " 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/l." 

#  if  SHOW 

nreverse  nreverse ( [ 1 , 2 , 3, 4 , 5, 6, 7 , 8 , 9, 10 ,  11, 12 , 

13,  14,  15, 16,  17,18,  19,20,21, 

22. 23. 24. 25. 26. 27. 28. 29. 30] , R) , 
write  (' reverse  of'),  nl, 

write  (  [1,2, 3,4,5,  6,7, 8,  9,  10,  11, 12, 
13,14,15,16,17,18,19,20,21, 

22,  23,  24,25,26,  27,  28,29,  30))  ,  nl, 
write(is),  nl, 
write (R),  nl. 

#  else 

nreverse  nreverse  ( ( 1 , 2,  3 ,  4 , 5,  6,  7,  8,  9,  10,  1 1, 12, 
13,14,15,16,17,18,19,20,21, 

22. 23. 24. 25. 26. 27. 28. 29. 30) ,  _)  . 

#  endif 
#endif 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (nreverse/2) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected, 
♦if  DUMMY 

nreverse  (_,  _)  . 

♦else 

nreverse ( (X  I L0 ], L)  nreverse (L0, LI) ,  concatenate (LI,  (X) , L) 
nreverse  ([],[]). 

concatena te ( (X  I  LI ) , L2,  [ X I L3) )  concatenate (LI, L2, L3)  . 
concatenate ( ( ) , L, L) . 

♦endif 


warren  *6 


qsort .m 


#  /* 

qsort. ra:  Warren  benchmark  qsort  master  file 
*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  optionis):  S _ OPTIONS _ $ 

% 

%  qsort 
% 

%  David  H.  D.  Warren 
% 

%  quicksort  a  list  of  50  integers 
#if  BENCH 

#  include  " .qsort -bench" 
lelse 

#opt ion  SHOW  » 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/1." 

#  if  SHOW 

qsort  qsort ( [27, 74, IT, 33, 94, 18, 46, 83, 65,  2, 
32,53,28,85,99,47,28,82,  6,  11, 

55,29,  39,81,  90,37,10,  0,  66,51, 

7,21,85,27,  31,  63,  75,  4,95,99, 

11.28,  61,  74,18,92,  40,53,59,  81, S,  (1), 
write  ('qsort  of'),  nl, 

write  ([27, 74, 17, 33,  94, 18,  46,  83,  65,  2, 

32.53.28,  85,  99,47,28,  82,  6,  11, 

55,29,39,  81,90,37,10,  0,66,  51, 

7,21,85,27,31,63,  75,  4,  95,  99, 

11,  28,  61,74,  18,92,40,  53,59,  8]),  nl, 
write (is) ,  nl, 
write (S) ,  nl. 

#  else 

qsort  qsort  ( [27,  74, 17,  33,  94, 18,  46,  83,  65,  2, 

32,53,28,85,  99,47,28,82,  6,  11, 

55,29,  39,81,  90,37,10,  0,  66,51, 

7,21,  85,27,  31,  63,75,  4,  95,  99, 

11.28,  61,74,18,92,40,53,59,  8 ],_,(])  . 

#  endif 
Oendif 

Koption  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (qsort/3)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
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#if  DUMMY 
qsort  (_,  _,  _)  . 
lelse 

qsort  ( [X|  L]  ,R,RO) 

part  it  Ion (L, X, LI,  L2) , 
qsort (L2, Rl, RO) , 
qsort (LI, R,  (X  I Rl ] )  . 
qsort  (  [],R,R)  ■ 

partition ( [XI L] , Y, [X I  LI) , L2) 

X  =<  Y,  ! , 

partition (L, Y, LI,  L2)  . 
part  it  ion ( (X I L] , Y, LI,  [XIL2]) 
partition (L, Y, LI, L2) . 
partition  ((],_,  [],  [  ] )  - 
lendif 
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♦  /* 

query. ra:  Warren  benchmark  query  master  file 
*/ 

»  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option(s):  $ _ OPTIONS _ S 

% 

%  q  ry 

% 

%  David  H.  D.  Warren 
% 

%  query  population  and  area  database  to  find  coun- 
%  tries  of  approximately  equal  population  density 

#if  BENCH 

♦  include  " .query .bench" 

♦else 

query  run_query. 

♦endif 

♦  option  DUMMY  '■ 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  ’dummy'  for 

>  the  benchmark  execution  predicate  (run_query/0) . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
♦if  DUMMY 

run_query . 

♦else 

run_query  query (_),  fail. 
run_query . 

query  (  [C1,D1,C2,D2]  ) 
density (Cl, Dl) , 
density (C2, D2) , 

Dl  >  D2, 

T1  is  20*D1, 

T2  is  21*D2, 

T1  <  T2. 

density(C.D) 
pop (C, P) , 
area  (C,  A)  , 

D  is  (P*100)/A. 
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%  populations  in  100000's 
pop  (china,  8250). 

pop(india,  5863)  . 

pop  (ussr,  2521)  . 

pop (usa,  2119)  . 

pop ( indonesia,  1276). 

pop  (japan,  1097). 

poplbrazil,  1042)  . 

pop  (bangi^du 750). 
pop (pakistan,  682). 

pop (w_germany,  620). 
pop  (nigeria,  613). 

pop(mexico,  581). 

pop  (uk,  559)  . 

pop ( italy,  554)  . 

pop(france,  525). 

pop (Philippines,  415). 
pop  (thailand,  410). 
pop  (turkey,  383)  . 

pop (egypt,  364) . 

popfspain,  352). 

pop (poland,  337). 

pop(s_korea,  335). 

pop (iran,  320) . 

pop (ethiopia,  272). 
pop (argentina,  251). 

%  areas  in  1000' s  of  square  miles 

area(china,  3380). 

area(india,  1139). 

area (ussr,  8708)  . 

area  (usa,  3609)  . 

area ( indonesia,  570). 

area (japan,  148) . 

area(brazil,  3288). 

area (bang lade sh,  55). 

area (Pakistan,  311). 

area (w_germany,  96). 

area (nigeria,  373). 

area (mexico,  764) . 

area  (uk,  86)  . 

area ( italy,  116) . 

areaffrance,  213)  . 

area (Philippines,  90). 

area  (thailand,  200). 

area  (turkey,  296). 

area (egypt,  386). 

area (Spain,  190) . 

area  (poland,  121). 

area  (s_korea,  37). 

area ( iran,  628)  . 

area  (ethiopia,  350). 

area (argentina,  1080). 

Dendif 
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#  /* 

serialise. m:  Warren  benchmark  serialise  master  file 

*/ 

%  generated:  _ MDAY _ MONTH _ YEAR _ 

%  option (s) :  $ _ OPTIONS _ S 

% 

%  serialise 

t 

%  David  H.  D.  Warren 
% 

%  itemize  (pick  a  "serial  number"  for  each 
%  unique  integer  in)  a  list  of  25  integers 

♦assign  PALIN25  "ABLE  WAS  I  ERE  I  SAW  ELBA" 

♦ 

#if  BENCH 

♦  include  “ . serial ise . bench" 

♦else 

♦  option  SHOW  '• 

>  Option  SHOW  introduces  code  which  writes  output 

>  to  show  what  the  benchmark  does.  This  may  help 

>  verify  that  the  benchmark  operates  correctly. 

> 

>  SHOW  has  no  effect  when  BENCH  is  selected.  The 

>  functionality  of  SHOW  is  then  available  through 

>  show/l." 

♦  if  SHOW 

serialise  serialise (PALIN25, S)  , 

write  (' serialisation  of'),  nl, 
printstring (PALIN25) ,  nl, 
write  (is)  ,  nl, 
write(S),  nl. 

printstring  < (1 1 . 

printstring ( [H I T] )  put (H) ,  pr intstring  (T)  . 

♦  else 

serialise  serialise (PALIN25, _) . 

♦  endif 
♦endif 

♦option  DUMMY  " 

>  To  facilitate  overhead  subtraction  for  performance 

>  statistics,  option  DUMMY  substitutes  a  'dummy'  for 

>  the  benchmark  execution  predicate  (serialise/2)  . 

> 

>  To  use  this,  generate  code  without  DUMMY  and  run 

>  it,  generate  code  with  DUMMY  and  run  it,  and  take 

>  the  difference  of  the  performance  statistics. 

> 

>  This  functionality  is  automatically  provided  with 

>  execution  time  measurement  when  BENCH  is  selected." 
♦if  DUMMY 

serialise (_, _) . 

♦else 

serialise (L, R) 

pairlists(L,R,A)  , 
arrange  (A,  T) , 
numbered (T, 1,  _)  . 

pairlists ( [XI L) ,  [Y I R) ,  (pair (X, Y)  I  A] )  pairlists (L, R, A)  . 
pair  lists  (  [] ,  [  ] ,  ( ) )  . 
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arrange ( [X  I L] , tree (Tl, X, T2) ) 
split  (L,X,L1,L 2)  , 
arrange (LI, Tl) , 
arrange (L2, T2)  . 
arrange (  [  ] , void) . 

split  (  [X  I  L] ,  X,  Ll,  L2)  !,  split  (L,  X,  LI,  L2)  . 

split ( [X ) LJ , Y,  [XIL1],L2)  before  (X, Y) ,  !,  split  (L, Y, Ll, L2) 

split ( (X l L] , Y, Ll,  (X  I L2 ] )  before(Y,X),  !,  split  (L, Y, Ll, L2) 

spilt  uj,_,  [] ,  i  j )  • 

before  (pair  (XI, _),  pair  (X2,  __)  )  XI  <  X2  . 

numbered (tree (Tl, pair (_, N1),T2),N0,N)  :  - 

numbered (Tl, NO, Nl) 

N2  is  Nl+1, 
numbered (T2,N2,N) . 
numbered (void, N, N) . 

#endif 
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#  /* 

set-up . dividelO :  bench  set-up  for  (deriv)  dividelO 
*/ 

dividelO  :-  driver (dividelO) . 

benchmark (dividelO, 

d(DIVIDE10_EXP,x,_)  , 
dummy (D IVIDE 10_EXP, x,  _) , 

1000)  . 

show (dividelO)  :-  d (DIVIDE10_EXP , x, D) , 
write  ('  (d/dx)  (' )  , 
write (D1VIDE10_EXP) , 
write  ('  )  ='  )  ,  nl, 
write  (D) ,  nl . 


((include  "driver 
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*  /* 

sec-up .  loglO :  bench  sec-up  for  (deriv)  loglO 
*/ 

loglO  driver (loglO)  . 

benchmark ( loglO, 

d(LOG10_EXP,x,_), 
dummy (LOG10_EXP, x, _) , 

1000)  . 

snow\iogiu)  d (LOG1C_£aP, x, 0) , 
write  ('  (d/dx)  ('  ) , 
wriCe (LOG10_EXP ) , 
write  ('  )  =' )  ,  nl, 
write  (D) ,  nl . 


((include  "driver" 
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#  /* 

set-up . ops8 :  bench  set-up  for  (deriv)  ods8 

*/ 

ops8  or iver (ops8 ) . 

benchmark (ops8, 

d(0PS8_EXP, x,_) , 
dummy (0PS8_EXP ,  x,  _)  , 

1000)  . 

show(ops8)  :-  d (0PS8_EXP , x, D) , 
write ( '  {d/dx) ( ' ) , 
write  (0PS8__EXP )  , 
write  {'  )  =  ' ) ,  nl, 
write  (D) ,  nl . 


*  include  "driver 
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»  /* 

set-up . t imeslO :  bench  set-up  for  (deriv) 
V 

timeslO  driver (timeslO) . 

benchmark (t imeslO , 

d (TIMES 10_EXP, x,_) , 
dummy (TIMES10_EXP ,  x, _)  , 

1000)  . 

show (timeslO)  d (TIMES10_EXP , x, D) , 
write  ( '  (d/dx)  ('  )  , 
write (TIMES10_EXP ) , 
write  (' )  ) ,  nl, 

write  (D) ,  nl . 


^include  "driver" 


t imeslO 
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#  /* 

set-up . nreverse  :  bench  set-up  for  nreverse 

*/ 

nreve-se  :-  driver (nreverse) . 

benchmark (nreverse, 

nreverse ([1,2, 3, 4,5, 6, 7, 8, 9, 10, 11, 12, 

13,  14,15, 16,  17,  18, 19,20,21, 

22, 23, 24, 25,  2 6,  27, 28, 29,  30], 
dummy  ([1,2,  3,  4,  5,  6,  7,8,9, 10,11,12, 
13,14,15,16,17,18,19,20,21, 

22,  23, 24, 25, 26,  27,  28,  29,  30],  _), 

1000)  . 

show (nreverse)  :-  nreverse (  [  1, 2, 3 , 4 , 5 , 6, 7 , 8 , 9 , 10, 11, 12, 

13, 14,  15,  16,  17,  18, 19,  20,  21, 

22, 23, 24, 25, 26, 27, 28, 29, 30 ],R), 
write  ('  reverse  of'),  nl, 
write  (  [1,  2,  3, 4, 5,  6,  7,8, 9, 10, 11, 12, 

13,  14, 15,  16,  17, 18, 19,  20,  21, 

22, 23, 24, 25,  2  6, 27, 28, 29, 30] ) ,  nl, 
write  ( is)  ,  nl , 
write  (R) ,  nl . 


^include  "driver” 
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»  /* 

set-up . qsort :  bench  set-up  for  qsort 
V 

qsort  :-  driver (qsort) . 
benchmark (qsort, 

qsort  (  [27, 74,  17,33,  94,  18,  46,  83,  65,  2, 

32,53,28,85,99,  47,28,  82,  6,  11, 

55,29,  39,81,  90,37,  10,  0,  66,51, 
7,21,85,27,31,  63,  75,  4,  95,  99, 

11,  28,  61,74,  18,  92,  40,5  3,59,  8],_,  (]), 
dummy  (  [27,  74,  17,  33,  94,  18,  46,  83,  65,  2, 

32,53,28,85,99,  47,28,82,  6,  11, 

55,29,39,81,  90,37,  10,  0,66,51, 
7,21,85,27,31,  63,75,  4,  95,  99, 

11, 28,  61, 74, 18,  92, 40, 53,5  9,  8) , 

1000)  . 

show(qsorc)  :-  qsort ( [27, 74, 17, 33, 94, 18, 46, 83, 65,  2, 

32,53,28,85,99,  47,  28,82,  6,  11, 

55,29,  39,81,  90,37,  10,  0,  66,51, 

7,  21,85,27,  31,  63,  75,  4,  95,  99, 
11,28,61,7  4,18,92,  40,  53,59,  8  ]  ,  S,  []  )  , 
write('qsort  of'),  nl, 
write  ( [27, 74,  17, 33,  94,  18, 4  6,  83,  65,  2, 

32.53.28,  85,  99,  47,28,82,  6,  11, 

55,29,  39,81,  90,37,  10,  0,  66,51, 

7,21,85,27,  31,  63,  75,  4,  95,  99, 

11.28,  61,  74,18,  92,40,  53,  59,  8]),  nl, 
write(is),  nl, 

write  (S) ,  nl . 


♦include  "driver" 
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.query .bench 


#  /* 

set-up .query :  bench  set-up  for  query 

V 

query  :-  dri ver (query) . 

benchmark (query,  run_query,  dummy,  100). 

show(query)  :-  query(X),  write(X),  nl,  fail, 
show (query) . 


♦include  "driver" 
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serialise .bench 


#  /* 

set-up . serialise :  bench  set-up  for  serialise 
*/ 

serialise  :-  driver ( serialise) . 

benchmark (serialise, 

serialise (PALIN25, _) , 
dummy  (PALIN25,_) , 

1000)  . 

show (serialise)  :-  serialise (PALIN25, S) , 

write  ('  serialisation  of'),  nl, 
printstring (PALIN25) ,  nl, 
write  (is) ,  nl, 
write (S) ,  nl . 

print  string  ( ( ] )  . 

printstring  ( [H I T] )  :-  put(H),  printstring (T)  . 


♦include  "driver" 
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